Amiga Plus Leser 15/Amiga Plus Leser CD 15.iso/Tools/Freeware/FWCalendar/FWCAddEvent.rexx

OS/2 REXX Batch file | 2002-03-13 | 117.4 KB | 3,330 lines

/*
    AddEvent.rexx Macro
    Adds events to calendars created by FWCalendar.rexx
    $VER: FWCAddEvent.rexx v4.06 (21 Feb 2002)
    ©Ron Goertz ([e-mail])
*/
MinFWCVer = 4.22
OPTIONS RESULTS
signal on syntax
options failat 11
Numeric Digits 14

parse source . . . FullCallPath . CallHost
CallHost = strip(CallHost)
ScriptDir = PathPart(FullCallPath)

CurrentDir = Pragma('D')
if right(CurrentDir, 1) ~= ':' then CurrentDir = CurrentDir'/'

call AddLibraries
if ErrorCount > 0 then call Cleanup

address value DetermineHost()
call SetVariables

Month = substr(TempDate,5,2) - 0
PrevMonth = Month - 1
if PrevMonth = 0 then PrevMonth = 12
NextMonth = Month + 1
if NextMonth = 13 then NextMonth = 1

Year = left(TempDate,4)
if (Year//4 == 0 & Year//100 > 0) | Year//400 == 0 Then MonthLength.2  = 29

interpret "StartDate = Day."Date('W', TempDate, 'S')
InternalStartMonth = DateInfo('I', TempDate, 'S')
InternalEndMonth = DateInfo('I', left(TempDate, 6)''MonthLength.Month, 'S')
if (DoExtended == 0) | (StartDate + MonthLength.Month > 35) then MaxDate = MonthLength.Month
else MaxDate = 35 - StartDate

FontName = Font.Highlight
FontSize = round(FSize.Highlight, 4)
if ClassAct == 1 then call GetEvent_CA
else call GetEvent_BGUI
exit

/*********************************************/
/*              Subroutines                  */
/*********************************************/
/***//*** AddBGUI (AB) ***/
AddBGUI:
  i = 0; AL_RexxBGUILib = i; AL_Lib.i = 'rexxbgui.library';    AL_MinVersion.i = 4;     AL_Offset.i = -30;  AL_Variable.i = 'RexxBGUILib'; AL_Status.i = "E"
  i = 1; AL_BGUILib = i;     AL_Lib.i = 'bgui.library';        AL_MinVersion.i = 41.1;  AL_Offset.i = '' ;  AL_Variable.i = 'BGUILib';     AL_Status.i = "E"

  do i = 0 to 1
    if exists('LIBS:'AL_lib.i) then do
      AL_InstalledVersion = PgmVer('LIBS:'AL_lib.i)
      AL_LibCount = AL_LibCount + 1
      Library.Name.AL_LibCount = AL_Lib.i
      Library.Version.AL_LibCount = AL_InstalledVersion
      if (AL_InstalledVersion < AL_MinVersion.i) | (AL_InstalledVersion == '') then do
        call AddMsg(AL_Status.i, AL_Lib.i' version 'AL_MinVersion.i' is required; your version is 'AL_InstalledVersion'.')
        interpret Al_Variable.i' = 0'
      end
      else do
        if i ~= AL_BGUILib then call addlib(AL_lib.i, 0, AL_Offset.i, trunc(AL_MinVersion.i))
        interpret Al_Variable.i' = 1'
      end
    end
    else do
      interpret Al_Variable.i' = 0'
      if (i = AL_RexxBGUILib) | (i = AL_BGUILib) then do
        if GUIWarning == 0 then do
          GUIWarning = 1
          call AddMsg('E', 'Either the ClassAct files or the BGUI files (see the docs)')
          call AddMsg('E', '  must be installed. Neither could be found...')
        end
      end
      else if AL_Status.i == 'E' then call AddMsg('E', AL_lib.i' is required but could not be found.')
    end
  end
  if RexxBGUILib == 1 then ClassAct = 0

  if (ClassAct == 0) & (bguiopen = 0) then bguiopen = bguiopen()

  return
/**/

/***//*** AddLibraries (AL) ***/
AddLibraries:
  AL_LibCount     = 0
  DoingCleanup    = 0
  PortList        = show('P')
  ErrorCount      = 0
  HostScreen      = ''
  WarningCount    = 0
  Req             = 0
  bguiopen        = 0
  Storage         = 'RAM:FWC/'
  ClassAct        = 0
  ForceBGUI       = 0
  ReqCAVersion    = 44.569
  ReqAPVersion    = 2.48
  ReqCAVersion    = 42.8
  ClassActMessage = ''
  AWNPipeMessage  = ''
  GUIWarning      = 0

  call TranslationStrings
  interpret ReadFile(ScriptDir'FWCTranslations.txt')

  i = 0; AL_DateLib = i;     AL_Lib.i = 'date.library';        AL_MinVersion.i = 33.31; AL_Offset.i = -492; AL_Variable.i = 'DateLib';     AL_Status.i = "W"
  i = 1; AL_RexxMathLib = i; AL_Lib.i = 'rexxmathlib.library'; AL_MinVersion.i = 38.01;  AL_Offset.i = -30;  AL_Variable.i = 'RexxMathLib'; AL_Status.i = "W"

  if (exists('L:awnpipe-handler')) then do
    if (exists('LIBS:gadgets/layout.gadget')) then do
    ClassActVersion = PgmVer('LIBS:gadgets/layout.gadget')
    AWNPipeVersion  = PgmVer('L:awnpipe-handler')
    if ClassActVersion < ReqCAVersion then do
      ClassActMessage = 'ClassAct version 'ReqCAVersion'+ is required; your version is 'ClassActVersion'. BGUI is being used'
      ForceBGUI = 1
    end
    if AWNPipeVersion < ReqAPVersion then do
      AWNPipeMessage = 'AWNPipe version 'ReqAPVersion'+ is required; your version is 'AWNPipeVersion'. BGUI is being used'
      ForceBGUI = 1
    end
    if ForceBGUI == 0 then ClassAct = 1
  end
  if ForceBGUI == 1 then ClassAct = 0

  do i = 0 to 1
    if exists('LIBS:'AL_lib.i) then do
      AL_InstalledVersion = PgmVer('LIBS:'AL_lib.i)
      AL_LibCount = AL_LibCount + 1
      Library.Name.AL_LibCount = AL_Lib.i
      Library.Version.AL_LibCount = AL_InstalledVersion
      if (i == AL_RexxMathLib) & (AL_InstalledVersion == '38.02') then AL_InstalledVersion = 38.2
      if (AL_InstalledVersion < AL_MinVersion.i) | (AL_InstalledVersion == '') then do
        call AddMsg(AL_Status.i, AL_Lib.i' version 'AL_MinVersion.i' is required; your version is 'AL_InstalledVersion'.')
        interpret Al_Variable.i' = 0'
      end
      else do
        call addlib(AL_lib.i, 0, AL_Offset.i, trunc(AL_MinVersion.i))
        interpret Al_Variable.i' = 1'
      end
    end
    else do
      interpret Al_Variable.i' = 0'
      if AL_Status.i == 'E' then call AddMsg('E', AL_lib.i' is required but could not be found.')
    end
  end
  if (DateLib == 1) | (RexxMathLib == 1) then PhaseLib = 1
  else PhaseLib = 0

  if ForceBGUI == 1 then call AddBGUI

  if ErrorCount > 0 then call Cleanup
  return
/**/

/***//*** AddMsg (AM) Subroutine ***/
AddMsg:
  parse arg AM_MsgType, AM_Msg

  if AM_MsgType == 'E' then do
    ErrorCount = ErrorCount + 1
    Error.ErrorCount = AM_Msg
  end
  else do
    WarningCount = WarningCount + 1
    Warning.WarningCount = AM_Msg
  end

  return
/**/

/***//*** AssignID (AID) ***/
AssignID:
  parse arg AID_Var, AID_ID

  interpret AID_Var' = 'AID_ID
  GE_Gad.AID_ID = AID_Var
  if left(AID_Var, 5) = 'GadID' then AID_Var = 'GadID'
  GE_Help.AID_ID = AID_Var'Help'

  return
/**/

/***//*** BusyReq (BR) ***/
/*** OpenBusy ***/
OpenBusy:
  parse arg BR_BusyTitle, BR_EventCount
  BR_Progress = 0
  if ClassAct == 1 then do
    call open('ProgReq', "awnpipe:ProgressReq/xc")
    call ToPIPE('ProgReq', 'm v cs si so a ps="'AppScreen'"')
    call ToPIPE('ProgReq', 'label gt="'BR_BusyTitle', 'PleaseWait$'..."')
    BR_ProgressGad = ToPIPE('ProgReq', 'fuelgauge defn=0 maxn='BR_EventCount' t=0 per')
    call ToPIPE('ProgReq', 'layout b=0 si so cj')
      call ToPIPE('ProgReq', 'space')
      BR_CancelGad = ToPIPE('ProgReq', 'button pb gt="'Cancel$'"')
      call ToPIPE('ProgReq', 'space')
    call ToPIPE('ProgReq', 'le')
    if ToPIPE('ProgReq', 'open') == 'window' then BR_ProgressWindow = 1
    else BR_ProgressWindow = 0
  end
  else do
    BR_ProgressGroup=bguivgroup(,
          bguiinfo('BR_dummy',,'1B'x||'c'BR_BusyTitle', 'PleaseWait$'...')bguilayout(LGO_FixMinHeight,1)||,
          bguiprogress('BR_prog2_',,0,BR_EventCount)||,
          bguihgroup(,
                  bguivarspace(50)bguilayout(LGO_FixMinHeight,1)||,
                  bguibutton('BR_cancel_',Cancel$)bguilayout(LGO_FixMinHeight,1)||,
                  bguivarspace(50)bguilayout(LGO_FixMinHeight,1),
          ,,,,'W'),
    ,-2,-2)
    BR_ProgressWindow = bguiwindow('',BR_ProgressGroup,,2,,AppScreen)
    if bguiwinopen(BR_ProgressWindow) = 0 then call Cleanup
  end

  return BR_ProgressWindow

/*** UpdateBusy ***/
UpdateBusy:
  parse arg BR_ReqWin, BR_ProgressMade

  if BR_ReqWin == 0 then return 0
  BR_Progress = BR_Progress + BR_ProgressMade
/* say '>'BR_Progress SIGL */
  if ClassAct == 1 then do
    if show('F', 'ProgReq') == 1 then do
      call writeln('ProgReq', 'id 'BR_CancelGad' read')
      BR_CancelStatus = readln('ProgReq')
      if BR_CancelStatus == 1 then do
        call close('ProgReq')
        return -1
      end
    end
    else return 0
    if show('F', 'ProgReq') == 1 then do
      call ToPIPE('ProgReq', 'id 0 s=2')
      call writeln('ProgReq', 'id 'BR_ProgressGad' defn='BR_Progress' ref')
      call readln('ProgReq')
    end
    else return 0
  end
  else do
    call bguiset(obj.BR_prog2_,BR_ReqWin,PROGRESS_Done,BR_Progress)
    if bguiwinevent(BR_ReqWin,'ID') == id.BR_cancel_ then return -1
  end

  return BR_Progress

/*** CloseBusy ***/
CloseBusy:
  parse arg BR_ReqWin

  if BR_ReqWin == 0 then return 0

  if ClassAct == 1 then call close('ProgReq')
  else call bguiwinclose(BR_ReqWin)
  Req = 0

  return 0
/**/

/***//*** CAGetFile (GF) ***/
CAGetFile:
  parse arg GF_FileHandle, GF_GadID, GF_Title, GF_InitDir

  call writeln(GF_FileHandle,'id 'GF_GadID' gt="'GF_Title':" fn="'GF_InitDir'" s=1')
  GF_GetFileResult = readln(GF_FileHandle)
  parse var GF_GetFileResult GF_OK GF_Choice GF_File
  if GF_Choice ~= 0 then GF_File = strip(GF_File, 'B', '" ')
  else GF_File = ''

  return GF_File
/**/

/***//*** CASimpleReq (CAS) ***/
CASimpleReq:
  parse arg CAS_Title, CAS_Msg, CAS_Time

  if CAS_Time == '' then do
    CAS_Msg = translate(CAS_Msg, "'", '"')
    do while pos('0a'x, CAS_Msg) > 0
      CAS_Msg = left(CAS_Msg, pos('0a'x, CAS_Msg) - 1)'*n'substr(CAS_Msg, pos('0a'x, CAS_Msg) + 1)
    end
    call open('Req', "awnpipe:SimpleReq/xc")
    call ToPIPE('Req', '"'CAS_Title'" m v db dg si so a ps="'AppScreen'"')
    call ToPIPE('Req', 'label gt="'CAS_Msg'"')
    call ToPIPE('Req', 'layout b=0 si so cj')
      call ToPIPE('Req', 'space')
      call AssignID('CAS_OKGad', ToPIPE('Req', 'button c gt="'OK$'"'))
      call AssignID('CAS_ViewGad', ToPIPE('Req', 'button c gt="'View$'"'))
      call ToPIPE('Req', 'space')
    call ToPIPE('Req', 'le')
    call ToPIPE('Req', 'open')

    do until eof('Req')
      call ToPIPE('Req', 'continue')
      CAS_EventInfo = readln('Req')
      parse var CAS_EventInfo CAS_Event' 'CAS_GadID' 'CAS_GadInfo1
      if CAS_GadID == CAS_ViewGad then ViewLog = 1
    end
    call close('Req')
  end
  else do
    call open('Req', "awnpipe:SimpleReq/xc")
    call ToPIPE('Req', 'm sk si so a ps="'AppScreen'"')
    call ToPIPE('Req', 'label gt="'CAS_Msg'"')
    call ToPIPE('Req', 'open')

    CAS_TickCount = 0
    do until CAS_TickCount >= CAS_Time
      call ToPIPE('Req', 'tick 100')
      Req_EventInfo = readln('Req')
      parse var Req_EventInfo Req_Event' 'Req_GadID' 'Req_GadInfo1
      select
        when Req_Event == 'key' then CAS_TickCount = CAS_Time
        when Req_Event = 'tick' then CAS_TickCount = CAS_TickCount + 1
        otherwise nop
      end
    end
    call close('Req')
  end

  return
/**/

/***//*** Cleanup () Subroutine ***/
Cleanup:
  signal off syntax

  if VariablesSet == 1 then do
    interpret UserPrefs
    call CloseBusy(Req)
    if App == 'FW' then do
      SELECTOBJECT
      REDRAW
      if upper(DecimalFormat) == 'COMMA' then DocItemPrefs Decimal Comma
    end
    else if App == 'PGS' then do
      SELECTOBJECT None WINDOW winName
      if WindowRefreshed ~= 1 then do
        REFRESH ON
        REFRESHWINDOW WINDOW winName
      end
    end
  end

  LogOpen = open('FWCLog', Storage'FWCLog.txt', 'W')
  if LogOpen == 0 then do
    address command 'makedir >NIL: 'left(Storage, length(Storage) - 1)
    LogOpen = open('FWCLog', Storage'FWCLog.txt', 'W')
  end
  if LogOpen == 1 then OutType = 'File'
  if ((WarningCount > 0) | (ErrorCount > 0)) & (LogOpen == 0) then do
    LogOpen = 1
    call open('FWCLog', 'CON:10/10/500/300/FWCalendar.rexx Message/WAIT/CLOSE')
    OutType = 'CON'
  end

  if LogOpen == 1 then do
    call writeln('FWCLog', '      Macro: 'strip(substr(sourceline(4), pos(':', sourceline(4)) + 1)))
    call writeln('FWCLog', 'Application: 'PgmVersion)
    call writeln('FWCLog', 'Current Dir: 'CurrentDir)
    call writeln('FWCLog', ' Script Dir: 'ScriptDir)
    call writeln('FWCLog', '       Host: 'CallHost)
    call writeln('FWCLog', '   Calendar: 'Month.Month' 'Year||'0a'x)
  end

  if (ErrorCount > 0) | (WarningCount > 0) then do
    do i = 1 to ErrorCount
      call writeln('FWCLog', Error.i)
    end

    do i = 1 to WarningCount
      call writeln('FWCLog', Warning.i)
    end

    if (PrefsFile ~= '') & (exists(PrefsFile)) then do
      call writeln('FWCLog', '0a'x||' -- 'PrefsFile' -- ')
      call open('DataFile', PrefsFile)
        do until eof('DataFile')
          Ln = ReadLn('DataFile')
          if pos('End Pass One', Ln) > 0 then leave
          call writeln('FWCLog', Ln)
        end
      call close('DataFile')
    end

    if (EventFile ~= '') & (symbol('EventFile') == 'VAR') then do
      call writeln('FWCLog', '0a'x||' -- 'EventFile' -- ')
      call open('DataFile', EventFile)
        do while ~eof('DataFile')
          if ~eof('DataFile') then call writeln('FWCLog', ReadLn('DataFile'))
        end
      call close('DataFile')
    end

    if ErrorCount > 0 then ErrorType = Critical$
    else ErrorType = Noncritical$
    FileMsg = ErrorType' ... 'See$' 'Storage'FWCLog.txt 'ForDetails$'.'||'0a'x||ForwardLog$': Ron Goertz <[e-mail]>'||'0a'x||Unable$
    Conbgui = ErrorType' ... 'SeeShell$'.'||'0a'x||ForwardContent$||'0a'x||'Ron Goertz <[e-mail]>'||'0a'x||Unable$
    ConCon  = ErrorType' ... 'SeeOutput$'.'||'0a'x||ForwardContent$||'0a'x||'Ron Goertz <[e-mail]>'||'0a'x||Unable$

    if (OutType == 'File') & (ClassAct == 1) then call CASimpleReq('FWCalendar 'Notice$, FileMsg)
    if (OutType == 'File') & (bguiopen == 1) then call bguireq('1B'x||'c'FileMsg,'*'OK$,'FWCalendar 'Notice$,,AppScreen)
    if (OutType == 'File') & (bguiopen == 0) & (ClassAct == 0) then do
      call open('CON', 'CON:10/10/500/300/FWCAddEvent notice/WAIT/CLOSE')
        call writeln('CON', FileMsg)
      call close('CON')
    end

    if (OutType == 'CON') & (ClassAct == 1) then call CASimpleReq('FWCalendar 'Notice$, Conbgui)
    if (OutType == 'CON') & (bguiopen == 1) then call bguireq('1B'x||'c'Conbgui,'*'OK$,'FWCalendar 'Notice$,,AppScreen)
    if (OutType == 'CON') & (bguiopen == 0) & (ClassAct == 0) then call Writeln('FWCLog', '0a'x||ConCon)
  end
  else do
    address command 'delete >NIL: 'Storage'FWC'App'Temp.txt quiet'
    if LogOpen == 1 then call writeln('FWCLog', 'No errors.')
  end

  address command 'delete >NIL: 'Storage'FWCTemp quiet'
  call close('FWCLog')
  if ViewLog == 1 then address command 'run MULTIVIEW 'Storage'FWCLog.txt'
  if bguiopen = 1 then call bguiclose()
  exit
/**/

/***//*** ConvertDay (CD) Subroutine***/
ConvertDay:
  parse arg CD_Day
  If upper(left(CD_Day,1)) == "P" then CD_Day = substr(CD_Day,2) - MonthLength.PrevMonth
  If upper(left(CD_Day,1)) == "N" then CD_Day = substr(CD_Day,2) + MonthLength.Month
  return CD_Day
/**/

/***//*** DateInfo (PROCEDURE) ***/
DateInfo: PROCEDURE
  /* DateInfo('I', '19780101', 'S') = 2443510  */
  /* Date('I', '19780101', 'S') = 0            */
  /* Option 'C' returns days since Jan 1, xx00 */
  parse arg Option, Date, Format

  if Option == '' then Option = 'N'
  if Date == '' then do
    Date = Date('S')
    Format = 'S'
  end

  Option = upper(left(Option, 1))
  Format = upper(left(Format, 1))
  if (Format == 'I') | (Format = '') then do
    Format = 'I'

    /* Routine to convert from a serial date to year/month/day obtained from the        */
    /* Sky & Telescope web site. The basic program from which the following was         */
    /* derived originally appeared in Astronomical Computing, Sky & Telescope,May, 1984 */
    A1 = trunc((Date / 36524.25) - 51.12264)
    A = Date + 1 + A1 - trunc(A1 / 4)
    B = A + 1524
    C = trunc((B / 365.25) - 0.3343)
    D = trunc(365.25 * C)
    E = trunc((B - D) / 30.61)
    D = B - D - trunc(30.61 * E)
    Month = E - 1
    Year = C - 4716
    IF E > 13.5 then Month = Month - 12
    IF Month < 2.5 then Year = Year + 1
    Day = trunc(D)
    J = Date
  end
  else do
    Year  = left(Date, 4) - 0
    Month = substr(Date, 5, 2) - 0
    Day   = right(Date, 2) - 0
    /* The following two lines are modified from PerpetualCalendar.bas that */
    /* appeared in Astronomical Computing, Sky & Telescope, July, 1985      */
    Temp = 0; if Month <= 2 then Temp = -1
    J = 367*Year-trunc(7*(Year+trunc((Month + 9)/12))/4)+trunc(275*Month/9)+1721031-trunc(3*(trunc((Year+Temp)/100)+1)/4) + Day - 2
  end

  select
    when Option == 'B' then do
      return J - 1721060
    end
    when Option == 'C' then do
      return J + 2 - DateInfo('I', left(right(Year, 4, '0'), 2)'000101', 'S')
    end
    when (Option == 'D') | (Option == 'J') then do
      DayCount = 0
      MonthLength.1    = 31
      MonthLength.2    = 28
      MonthLength.3    = 31
      MonthLength.4    = 30
      MonthLength.5    = 31
      MonthLength.6    = 30
      MonthLength.7    = 31
      MonthLength.8    = 31
      MonthLength.9    = 30
      MonthLength.10   = 31
      MonthLength.11   = 30
      MonthLength.12   = 31
      if (Year//4 == 0 & Year//100 > 0) | Year//400 == 0 Then MonthLength.2 = 29

      do I = (Month - 1) to 1 by -1
        DayCount = DayCount + MonthLength.I
      end
      if Option == 'D' then return DayCount + Day
      else return right(Year, 2)''right(DayCount + Day, 3, '0')
    end
    when Option == 'E' then do
      return right(Day, 2, '0')'/'right(Month, 2, '0')'/'right(Year, 2, '0')
    end
    when Option == 'I' then return J
    when (Option == 'M') | (Option == 'N') then do
      Select
        when Month ==  1 then Month = 'January'
        when Month ==  2 then Month = 'February'
        when Month ==  3 then Month = 'March'
        when Month ==  4 then Month = 'April'
        when Month ==  5 then Month = 'May'
        when Month ==  6 then Month = 'June'
        when Month ==  7 then Month = 'July'
        when Month ==  8 then Month = 'August'
        when Month ==  9 then Month = 'September'
        when Month == 10 then Month = 'October'
        when Month == 11 then Month = 'November'
        when Month == 12 then Month = 'December'
      end
      if Option == 'M' then return Month
      else return right(Day, 2, '0')' 'left(Month, 3)' 'Year
    end
    when Option == 'O' then return right(Year, 2, '0')'/'right(Month, 2, '0')'/'right(Day, 2, '0')
    when Option == 'S' then return right(Year, 4, '0')''right(Month, 2, '0')''right(Day, 2, '0')
    when Option == 'U' then return right(Month, 2, '0')'/'right(Day, 2, '0')'/'right(Year, 2, '0')
    when Option == 'W' then do
      J = J + 1
      Weekday = J - 7 * trunc(J / 7)
      Select
        when Weekday == 0 then return 'Sunday'
        when Weekday == 1 then return 'Monday'
        when Weekday == 2 then return 'Tuesday'
        when Weekday == 3 then return 'Wednesday'
        when Weekday == 4 then return 'Thursday'
        when Weekday == 5 then return 'Friday'
        when Weekday == 6 then return 'Saturday'
      end
    end
    otherwise return 0
  end
/**/

/***//*** DetermineHost () Subroutine ***/
DetermineHost:
  owner = ReadFile('ENV:Owner')
  if (pos('FINALWRITER', upper(CurrentDir)) > 0) | (left(CallHost, 6) == 'FINALW') then do
    App     = 'FW'
    AppName = 'FINALWRITER'
    if CallHost == 'REXX' then HostPort = substr(PortList, pos('FINALW.', PortList), 8)
    else HostPort = CallHost
    address value HostPort
    GETDOCITEMPREFS Decimal; DecimalFormat = result
    DOCITEMPREFS Decimal Period
  end
  else if (pos('PAGESTREAM', upper(CurrentDir)) > 0) | (CallHost == 'PAGESTREAM') then do
    App     = 'PGS'
    AppName = 'PAGESTREAM'
    HostPort = 'PAGESTREAM'
  end
  else do
    call AddMsg('E', 'Unable to determine host!')
    call AddMsg('E', 'Make sure FWCAddEvent is called from Final Writer or PageStream')
    call Cleanup
  end

  PgmVersion = getclip('FWC'App'VersionInfo.txt')
  if PgmVersion == '' then do
    address command 'list >PIPE:FWC 'AppName'#? lformat %N'
    ListOutput = ReadFile('PIPE:FWC')
    call openv('ListOutput')
      do while ~eofv('ListOutput')
        PgmName = readvln('ListOutput')
        if pos('.', PgmName) == 0 then leave
      end
    call closev('ListOutput')
    address command 'version >PIPE:FWC 'PgmName
    PgmVersion = ReadFile('PIPE:FWC')

    if left(PgmVersion, 34) == 'Could not find version information' then do
      if App == 'FW' then do
        call open('Temp', CurrentDir''PgmName)
          /* Desired string at 325365 for v 5.06 */
          /* Desired string at 333771 for FW97   */
          FileOffset = 325300
          call seek('Temp', FileOffset, 'B')
          do until (EndPos ~= 0) | (PrevOffset = FileOffset)
            PrevOffset = FileOffset
            Chunk = readch('Temp', 10000)
            EndPos = pos('Created', Chunk)
            if EndPos == 0 then FileOffset = seek('Temp', -100, 'C')
          end
          if EndPos ~= 0 then do
            StartPos = lastpos('Final', Chunk, EndPos)
            EndPos = pos('00'x||'00'x, Chunk, StartPos)
            PgmVersion = substr(Chunk, StartPos, EndPos - StartPos - 1)
          end
          else do
            FileOffset = 0
            call seek('Temp', FileOffset, 'B')
            do until (EndPos ~= 0) | (PrevOffset = FileOffset)
              PrevOffset = FileOffset
              Chunk = readch('Temp', 10000)
              EndPos = pos('FinalWriter 97', Chunk)
              if EndPos == 0 then FileOffset = seek('Temp', -100, 'C')
            end
            if EndPos ~= 0 then PgmVersion = 'FinalWriter 97'
            else PgmVersion = 'Final Writer - version unknown'
          end
        call close('Temp')
      end
      else if App == 'PGS' then do
        PgmVersion = PgmName" - can't find version info"
      end
      call setclip('FWC'App'VersionInfo.txt', PgmVersion)
    end
  end

  AppScreen = ''
  PubScreenApps = 'FrontPubScreen Publican MagicPubName'
  do i = 1 to words(PubScreenApps)
    interpret 'address command "'word(PubScreenApps, i)' >PIPE:FWC"'
    if RC > 0 then iterate
    AppScreen = readfile('PIPE:FWC')
    if AppScreen ~= '' then leave
  end

  return HostPort
/**/

/***//*** DrawBox (DB) Subroutine ***/
DrawBox:
  parse arg DB_x1, DB_y1, DB_Width, DB_Height, DB_Weight, DB_Color, DB_FillBool, DB_FillColor, DB_Tint

  if DB_FillColor == '<'Clear$'>' then DB_FillBool = 0

  if App == 'FW' then do
    if DB_Weight == 'HL' then DB_Weight = 'Hairline'
    else if DB_Weight == 0 then do
      DB_Weight = 'None'
      if DB_FillColor ~= '<'Clear$'>' then DB_Color = DB_FillColor
    end

    if DB_FillBool == 1 then DB_FillBool = 'Solid'
    else do
      DB_FillBool = 'Transparent'
      DB_FillColor = DB_Color
    end

    BOXPREFS LINEWT DB_Weight LINECOLOR '"'DB_Color'"' FILL DB_FillBool FILLCOLOR '"'DB_FillColor'"'
    DRAWBOX 1 DB_x1 DB_y1 DB_Width DB_Height; DB_id = result
  end
  else if App == 'PGS' then do
    if DB_Weight == 'HL' then DB_Weight = 0.3pt
    else DB_Weight = DB_Weight'pt'

    if DB_FillBool == 1 then DB_FillBool = 'ON'
    else DB_FillBool = 'OFF'

    If DB_Weight == 0 then DB_LineBool = 'OFF'
    else DB_LineBool = 'ON'

    DRAWBOX DB_x1 DB_y1 DB_x1 + DB_Width DB_y1 + DB_Height WINDOW winName; DB_id = result
    STROKED DB_LineBool OBJECTID DB_id WINDOW winName
    SETSTROKEWEIGHT DB_Weight STROKENUMBER 0 OBJECTID DB_id WINDOW winName
    SETCOLORSTYLE '"'DB_Color'"' COLORNUMBER 0 STROKENUMBER 0 OBJECTID DB_id WINDOW winName
    FILLED DB_FillBool OBJECTID DB_id WINDOW winName
    SETCOLORSTYLE '"'DB_FillColor'"' COLORNUMBER 0 FILL OBJECTID DB_id WINDOW winName
    SETCOLORTINT DB_Tint FILL OBJECTID DB_id WINDOW winName
  end
  return DB_id
/**/

/***//*** dTox (PROCEDURE) Subroutine ***/
dTox:PROCEDURE
parse arg DecVal

BinVal = ''
HexVal = ''
do i = 32 to 0 by -1
  if DecVal >= 2**i then do
    BinVal = BinVal'1'
    DecVal = DecVal - 2**i
  end
  else BinVal = BinVal'0'
end

do until BinVal == ''
  HexVal = c2x(b2c(right(BinVal, 8, '0')))''HexVal
  if length(BinVal) >= 8 then CutLength = 8
  else CutLength = length(BinVal)
  BinVal = left(BinVal, length(BinVal) - CutLength)
end

return HexVal
/**/

/***//*** GetEvent_BGUI (GE) Subroutine ***/
GetEvent_BGUI:
  do GE_i = 0 to 15
    linelist_.GE_i = GE_i
  end
  linelist_.COUNT = min(RowsThatFit, 16)

  call bguilist("eventlist_",Event$,Image$,File$)
  call bguilist("FrequencyList", Once$, Weekly$, Biweekly$)

  GE_StartOrEnd   = 1
  GE_StartDate    = ""
  GE_EndDate      = ""
  GE_Boxed.0      = ""
  GE_Boxed.128    = "B"
  GE_Weekly.0     = ""
  GE_Weekly.1     = "W"
  GE_Weekly.2     = "2"
  GadID.          = ''
  GE_Arg.         = ''
  GE_i            = 0
  GE_Day          = 0
  GE_PrevDay      = MonthLength.PrevMonth - StartDate
  GE_NextDay      = 0

  Req = OpenBusy(PrepReq$, 45)
  do while (GE_i < 6)
    GE_j = 0
    do while (GE_j < 7)
      call UpdateBusy(Req, 1)
      GE_SerialPosition = (GE_i * 7) + GE_j
      GE_Button = GE_SerialPosition + 1
      if (GE_SerialPosition >= StartDate) & (GE_SerialPosition < StartDate + MonthLength.Month) then Do
        GE_Day = GE_Day + 1
        interpret "GadID."GE_Button" = bguibutton('"GE_Button"_', GE_Day)"
        GadID = GetID(GE_Button'_')
        GE_Arg.GadID = 'C 'left(Month.Month, 3)' 'GE_Day
      end
      else do
        if GE_SerialPosition < StartDate then Do
          GE_PrevDay = GE_PrevDay + 1
          interpret "GadID."GE_Button" = bguibutton('"GE_Button"_', GE_PrevDay)"
          GadID = GetID(GE_Button'_')
          GE_Arg.GadID = 'P 'left(Month.PrevMonth, 3)' 'GE_PrevDay
        end
        else do
          GE_NextDay = GE_NextDay + 1
          interpret "GadID."GE_Button" = bguibutton('"GE_Button"_', GE_NextDay)"
          GadID = GetID(GE_Button'_')
          GE_Arg.GadID = 'N 'left(Month.NextMonth, 3)' 'GE_NextDay
        end
      end
      GE_j = GE_j + 1
    end
    GE_i = GE_i + 1
    if GE_SerialPosition >= StartDate + MonthLength.Month - 1 then leave
  end

  DateButtons = bguihgroup(GadID.1""GadID.2""GadID.3""GadID.4""GadID.5""GadID.6""GadID.7)||,
                bguihgroup(GadID.8""GadID.9""GadID.10""GadID.11""GadID.12""GadID.13""GadID.14)||,
                bguihgroup(GadID.15""GadID.16""GadID.17""GadID.18""GadID.19""GadID.20""GadID.21)||,
                bguihgroup(GadID.22""GadID.23""GadID.24""GadID.25""GadID.26""GadID.27""GadID.28)
  if GE_i > 4 then DateButtons = DateButtons''bguihgroup(GadID.29""GadID.30""GadID.31""GadID.32""GadID.33""GadID.34""GadID.35)
  if GE_i > 5 then DateButtons = DateButtons''bguihgroup(GadID.36""GadID.37""GadID.38""GadID.39""GadID.40""GadID.41""GadID.42)

  g=bguivgroup(,
    bguihgroup(,
      bguicycle("eventtype_",,"eventlist_")bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight,1)||,
      bguistring("event_",,,256)bguilayout(LGO_FixMinHeight,1)||,
      bguiibutton('getfile_','B','F')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight, 1),
    )||,
    bguihgroup(,
      bguistring('fontvalue_',Font$':',FontName,256)bguilayout(LGO_Weight,50,LGO_FixMinHeight,1)||,
      bguistring('fontsize_',,FontSize,8)bguilayout(LGO_Weight,10,LGO_FixMinHeight,1)||,
      bguiibutton('addfont_','B','F')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight, 1)||,
      bguibutton("reset_",Reset$)bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight,1),
    )||,
    bguihgroup(,
      bguivgroup(,
        bguiinfo('dummy_',,esc'c'Month.Month)bguilayout(LGO_FixMinHeight, 1)||,
        bguihgroup(,
          bguiinfo("dummy_",,esc"c"left(TransDay.0,1))||,
          bguiinfo("dummy_",,esc"c"left(TransDay.1,1))||,
          bguiinfo("dummy_",,esc"c"left(TransDay.2,1))||,
          bguiinfo("dummy_",,esc"c"left(TransDay.3,1))||,
          bguiinfo("dummy_",,esc"c"left(TransDay.4,1))||,
          bguiinfo("dummy_",,esc"c"left(TransDay.5,1))||,
          bguiinfo("dummy_",,esc"c"left(TransDay.6,1)),
        )||,
        DateButtons,
      )||,
      bguivgroup(,
        bguiinfo("startchoice_",esc"r"Start$':',"")bguilayout(LGO_FixMinHeight, 1)||,
        bguiinfo("endchoice_",esc"r"End$':',"")bguilayout(LGO_FixMinHeight, 1)||,
        bguicycle('textcolor_',esc"r"TextColor$':','TextColorList')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight, 1)||,
        bguicycle("linechoice_",esc"r"Line$':',"linelist_")bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight,1)||,
        bguicheckbox("boxchoice_",esc"r"Boxed$':',0)bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight,1)||,
        bguicycle('boxcolor_',esc"r"BoxColor$':','ColorList')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight, 1)||,
        bguicycle("weeklychoice_",esc"r"Frequency$':','FrequencyList')bguilayout(LGO_FixMinWidth,1,LGO_FixMinHeight,1)||,
        bguihgroup(,
          bguibutton("OK_",OK$)bguilayout(LGO_FixMinHeight,1)||,
          bguibutton("cancel_",Cancel$)bguilayout(LGO_FixMinHeight,1)||,
          bguibutton("undo_",Undo$)bguilayout(LGO_FixMinHeight,1),
        ),
      ),
    ),
  ,"-1","-1")

  call UpdateBusy(Req, 1)
  GE_winID=bguiwindow(EnterEventInfo$':',g,5,0,,AppScreen)
  call UpdateBusy(Req, 1)

  if App == 'PGS' then do
    FontGroup=bguivgroup(bguilistview('fontlistview_',,'FontList'))
    call UpdateBusy(Req, 1)
    FontwinID=bguiwindow(SelectFont$':',FontGroup,20,50,,AppScreen)
  end

  call bguiset(obj.linechoice_,GE_winID,CYC_Active,1)
  call bguiset(obj.boxcolor_,GE_winID,CYC_Active,max(0, MemberID(Background.AddEvent,'ColorList', ColorList.Count, 0)))
  call bguiset(obj.textcolor_,GE_winID,CYC_Active,max(0, MemberID(Color.AddEvent,'ColorList', ColorList.Count, 0)))
  call bguiset(obj.event_,,BT_Key,EventKey)
  call bguiwintabcycleorder(GE_winID,obj.event_||obj.fontsize_)
  call bguiset(obj.undo_, GE_winID, GA_Disabled, 1)

  if bguiwinopen(GE_winID)=0 then bguierror(12)

  call CloseBusy(Req)

  id=0
  do while 1
    call bguiwinwaitevent(GE_winID,"ID")
    select
      when (id == id.cancel_) | (id == id.winclose) then call Cleanup
      when id == id.winactive then nop
      when id == id.wininactive then nop
      when id == id.event_ then nop
      when id == id.linechoice_ then nop
      when id == id.boxchoice_ then nop
      when id == id.textcolor_ then nop
      when id == id.boxcolor_ then nop
      when id == id.weeklychoice_ then nop
      when id == id.eventtype_ then do
        GE_EventType = bguiget(obj.eventtype_, CYC_Active)
        GE_StartOrEnd = 1
        if Type.GE_EventType == Event$ then GE_DisableFlag = 0
        else GE_DisableFlag = 1
        call bguiset(obj.event_,GE_winID,STRINGA_TextVal,"")
        call bguiset(obj.getfile_, GE_winID, GA_Disabled, 1-GE_DisableFlag)
        call bguiset(obj.textcolor_, GE_winID, GA_Disabled, GE_DisableFlag)
        call bguiset(obj.boxcolor_, GE_winID, GA_Disabled, GE_DisableFlag)
        call bguiset(obj.linechoice_, GE_winID, GA_Disabled, GE_DisableFlag)
        call bguiset(obj.boxchoice_, GE_winID, GA_Disabled, GE_DisableFlag)
        call bguiset(obj.weeklychoice_, GE_winID, GA_Disabled, GE_DisableFlag)
        call bguiset(obj.reset_, GE_winID, GA_Disabled, GE_DisableFlag)
        call bguiset(obj.addfont_, GE_winID, GA_Disabled, GE_DisableFlag)
        call bguiset(obj.fontsize_, GE_winID, GA_Disabled, GE_DisableFlag)
        call bguiset(obj.fontvalue_, GE_winID, GA_Disabled, GE_DisableFlag)
      end
      when id == id.getfile_ then do
        if Type.GE_EventType == Image$ then do
          address command 'assign >NIL: FWC: 'ScriptDir'Images/'
          if RC == 20 then GE_Dir = ScriptDir
          else do
            GE_Dir = ScriptDir'Images/'
            address command 'assign >NIL: FWC:'
          end
          GE_DataFile = bguifilereq(GE_Dir, SelectImage$, GE_winID)
        end
        else do
          GE_DataFile = bguifilereq(ScriptDir, SelectFile$, GE_winID,DOPATTERNS,PatVar)
        end
        if ~exists(GE_DataFile) then do
          call bguireq(GE_DataFile' 'CantFind$'...','*'OK$,'FWCAddEvent 'Notice$,GE_winID)
          GE_DataFile = ''
        end
        else call bguiset(obj.event_,GE_winID,STRINGA_TextVal,GE_DataFile)
      end
      when id == id.reset_ then do
        FontName = Font.Highlight
        FontSize = FSize.Highlight
        call bguiset(obj.fontvalue_, GE_winID, STRINGA_TextVal,FontName)
        call bguiset(obj.fontsize_, GE_winID, STRINGA_TextVal,FontSize)
      end
      when id == id.fontvalue_ then do
        call bguireq('1b'x||"c"MustUse$,"*"OK$,'',GE_winID)
        call bguiset(obj.fontvalue_, GE_winID,STRINGA_TextVal, FontName)
      end
      when id == id.fontsize_ then nop
      when id == id.addfont_ then do
        call bguiwinbusy(GE_winID)
        if App == 'FW' then do
          FontFile = bguifilereq(CurrentDir'FWFonts/SWOLFonts/', SelectFont$':', GE_winID,,'#?')
          if FontFile ~= '' then call bguiset(obj.fontvalue_, GE_winID, STRINGA_TextVal,FontFile)
        end
        else if App == 'PGS' then do
          call bguiwinopen(FontwinID)
          do while 1
            call bguiwinwaitevent(FontwinID,'ID')
            if id == id.winclose then leave
            if id == id.fontlistview_ then do
              call bguiset(obj.fontvalue_, GE_winID, STRINGA_TextVal,bguiget(obj.fontlistview_, LISTV_LastClicked))
              leave
            end
          end
          call bguiwinclose(FontwinID)
        end
        call bguiwinready(GE_winID)
        FontName = bguiget(obj.fontvalue_, STRINGA_TextVal)
      end
      when id == id.ok_ then do
        GE_EventValue = bguiget(obj.event_, STRINGA_TextVal)
        GE_BoxValue   = bguiget(obj.boxchoice_, GA_Selected)
        GE_EventType  = bguiget(obj.eventtype_, CYC_Active)
        if (GE_StartDate == "") & (Type.GE_EventType == Event$) then call bguireq(EnterStartDate$'...','*'OK$,'FWCAddEvent 'Notice$,GE_winID)
        else if (GE_EventValue == "") & (GE_Boxed.GE_BoxValue == "") then call bguireq(EnterEvent$'...','*'OK$,'FWCAddEvent 'Notice$,GE_winID)
        else do
          GE_WeeklyValue  = bguiget(obj.weeklychoice_, CYC_Active)

          EventData = "   EventType = "Type.GE_EventType||'0a'x||,
                      " EnteredFont = "strip(FontName)||'0a'x||,
                      " EnteredSize = "strip(bguiget(obj.fontsize_, STRINGA_TextVal))||'0a'x||,
                      " EnteredDay1 = "strip(GE_StartDate)||'0a'x||,
                      " EnteredDay2 = "strip(GE_EndDate)||'0a'x||,
                      " EnteredLine = "bguiget(obj.linechoice_, CYC_Active)||'0a'x||,
                      "     Options = "GE_Boxed.GE_BoxValue""GE_Weekly.GE_WeeklyValue||'0a'x||,
                      "   TextColor = "value('ColorList.'bguiget(obj.textcolor_, CYC_Active))||'0a'x||,
                      "    BoxColor = "value('ColorList.'bguiget(obj.boxcolor_, CYC_Active))||'0a'x||,
                      "EnteredEvent = "GE_EventValue

          call bguiwinclose(GE_winID)
          call ProcessEvent
          call bguiwinopen(GE_winID)

          if UndoLevel == 0 then UndoStatus = 1
          else UndoStatus = 0
          call bguiset(obj.undo_, GE_winID, GA_Disabled, UndoStatus)

          GE_StartOrEnd = 1
          GE_StartDate  = ""
          GE_EndDate    = ""
          call bguiset(obj.startchoice_,GE_winID,INFO_TextFormat,'')
          call bguiset(obj.endchoice_,GE_winID,INFO_TextFormat,'')
        end
      end
      when id == id.undo_ then do
        call bguiwinclose(GE_winID)
          do GE_i = 1 to Undo.UndoLevel.0
            if App == 'FW' then DELETEOBJECT Undo.UndoLevel.GE_i
            else if App == 'PGS' then do
              SELECTOBJECT OBJECTID Undo.UndoLevel.GE_i WINDOW winName
              DELETEOBJECT OBJECTID Undo.UndoLevel.GE_i WINDOW winName
            end
          end
          UndoLevel = UndoLevel - 1
          if UndoLevel == 0 then UndoStatus = 1
          else UndoStatus = 0
          call bguiset(obj.undo_, GE_winID, GA_Disabled, UndoStatus)
        call bguiwinopen(GE_winID)
      end
      otherwise do
        GE_StartOrEnd = 1 - GE_StartOrEnd
        GE_ReturnDate = strip(substr(GE_Arg.id, 1, 1)""right(GE_Arg.id, 2), "B", "C")
        GE_Date = substr(GE_Arg.id, 3)
        if GE_StartOrEnd == 0 then do
          call bguiset(obj.startchoice_,GE_winID,INFO_TextFormat,esc"l"GE_Date)
          GE_StartDate = GE_ReturnDate
        end
        else do
          call bguiset(obj.endchoice_,GE_winID,INFO_TextFormat,esc"l"GE_Date)
          GE_EndDate = GE_ReturnDate
        end
      end
    end
  end
  exit
/**/

/***//*** GetEvent_CA (GE) Subroutine ***/
GetEvent_CA:
  /***//*** Initialize Variables ***/
  Req = OpenBusy(PrepReq$, 4 + (ColorList.Count - 1))

  GE_BoxValue     = ''
  GE_EnteredLine  = 1
  GE_EventType    = Event$
  GE_EventValue   = ''
  GE_StartOrEnd   = 1
  GE_StartDate    = ""
  GE_EndDate      = ""
  GE_WeeklyValue  = ''
  GE_Day          = 0
  GE_PrevDay      = MonthLength.PrevMonth - StartDate
  GE_NextDay      = 0
  GE_StoreEvent$  = ''
  GE_StoreImage$  = ''
  GE_StoreFile$   = ''
  LineList        = ''
  ColorList       = ''
  FontReq         = 0
  ColorReq        = 0
  NCColorReq      = 0
  interpret 'GE_TextColor = ColorList.'max(0, MemberID(Color.AddEvent,'ColorList', ColorList.Count, 0))
  interpret 'GE_BoxColor = ColorList.'max(0, MemberID(Background.AddEvent,'ColorList', ColorList.Count, 0))

  GadID.          = ''
  GadArg.         = ''
  GE_Boxed.0      = ""
  GE_Boxed.1      = "B"
  GE_Type.0       = Event$
  GE_Type.1       = Image$
  GE_Type.2       = File$
  GE_Weekly.0     = ""
  GE_Weekly.1     = "W"
  GE_Weekly.2     = "2"

  do GE_i = 0 to 15
    LineList = LineList''GE_i'|'
  end
  LineList.Count = min(RowsThatFit, 16)

  do GE_i = 0 to ColorList.Count - 1
    ColorList = ColorList''ColorList.GE_i'|'
  end
  ColorList = '"'strip(ColorList, 'B', '|')'"'

  EventList = '"'Event$'|'Image$'|'File$'"'
  FrequencyList = '"'Once$'|'Weekly$'|'Biweekly$'"'

  if UpdateBusy(Req, 1) == -1 then call Cleanup
/**/

  /***//*** GUI Description ***/
  call open('GE',"awnpipe:AddEvent/xc")
  FWCAddEventVersion = '('strip(word(sourceline(4), 3))')'

  call ToPIPE('GE', '"'EnterEventInfo$' 'FWCAddEventVersion'" m cg dg v db a so si cs sk h ps="'AppScreen'"')

  call ToPIPE('GE', 'layout v so si b=0')
    call ToPIPE('GE', 'layout b=0')
      call AssignID('GE_EventTypeGad', ToPIPE('GE', 'chooser weiw=0 pu cl='EventList' ref'))
      call AssignID('GE_EventGad', ToPIPE('GE', 'string tc lj ref'))
      call AssignID('GE_ChooseFileGad', ToPIPE('GE', 'button ab=0 weiw=0 weih=0 dis=1 ref'))
    call ToPIPE('GE', 'le')

    call ToPIPE('GE', 'layout b=0')
      call ToPIPE('GE', 'label gt="'Font$':" ua ref')
      call AssignID('GE_FontNameGad', ToPIPE('GE', 'string lj tc chl weiw=95 gt="'FontName'" ref'))
      call AssignID('GE_FontSizeGad', ToPIPE('GE', 'string lj tc minc=6 weiw=0 gt="'FontSize'" ref'))
      call AssignID('GE_ChooseFontGad', ToPIPE('GE', 'button ab=2 weiw=0 weih=0 ref'))
      call AssignID('GE_ResetGad', ToPIPE('GE', 'button weih=0 weiw=0 gt="'Reset$'" ref'))
    call ToPIPE('GE', 'le')
  call ToPIPE('GE', 'le')

  call ToPIPE('GE', 'layout weiw=0 b=0')
    call ToPIPE('GE', 'layout weiw=0 so v')
      call ToPIPE('GE', 'layout so b=0')
        call ToPIPE('GE', 'space')
        call AssignID('GE_MonthGad', ToPIPE('GE', 'button ro b=0 gt="'Month.Month'" ref'))
        call ToPIPE('GE', 'space')
      call ToPIPE('GE', 'le')

      call ToPIPE('GE', 'layout e b=0')
        do i = 0 to WeekDayCount
          interpret "call ToPIPE('GE', 'button ro b=0 gt='QuoteMark''left(TransDay.i, 1)''QuoteMark' ref')"
        end
      call ToPIPE('GE', 'le')

      if UpdateBusy(Req, 1) == -1 then call Cleanup

      do GE_Week = 0 to 5
        if GE_Week * 7 + WeekdayCount < StartDate then do
          GE_Day = 7 - StartDate
          iterate
        end
        call ToPIPE('GE', 'layout e b=0')
        do GE_WeekDay = 0 to 6
          GE_Posn = (GE_Week * 7) + GE_WeekDay
          if (GE_Posn >= StartDate) & (GE_Posn < StartDate + MonthLength.Month) then do
            GE_Day = GE_Day + 1
            if GE_WeekDay <= WeekdayCount then do
              call AssignID('GadID.'GE_Posn, ToPIPE('GE', 'button gt="'GE_Day'" ref'))
              interpret "GadArg."GadID.GE_Posn" = 'C'left(Month.Month, 3)' 'GE_Day"
            end
          end
          else do
            if GE_Posn < StartDate then do
              GE_PrevDay = GE_PrevDay + 1
              if GE_WeekDay <= WeekdayCount then do
                call AssignID('GadID.'GE_Posn, ToPIPE('GE', 'button gt="'GE_PrevDay'" ref'))
                interpret "GadArg."GadID.GE_Posn" = 'P'left(Month.PrevMonth, 3)' 'GE_PrevDay"
              end
            end
            else do
              GE_NextDay = GE_NextDay + 1
              if GE_WeekDay <= WeekdayCount then do
                call AssignID('GadID.'GE_Posn, ToPIPE('GE', 'button gt="'GE_NextDay'" ref'))
                interpret "GadArg."GadID.GE_Posn" = 'N'left(Month.NextMonth, 3)' 'GE_NextDay"
              end
            end
          end
        end
        call ToPIPE('GE', 'le')
        if GE_Posn >= StartDate + MonthLength.Month - 1 then leave
      end
    call ToPIPE('GE', 'le')

    if UpdateBusy(Req, 1) == -1 then call Cleanup
    call ToPIPE('GE', 'layout weiw=0 si so v')
      call ToPIPE('GE', 'layout weiw=0 si so b=0 v')
        call ToPIPE('GE', 'label weiw=0 ua gt="'Start$':" ref')
        call AssignID('GE_StartGad', ToPIPE('GE', 'button lj chl ro b=0 ref'))
        call ToPIPE('GE', 'label weiw=0 ua gt="'End$':" ref')
        call AssignID('GE_EndGad', ToPIPE('GE', 'button lj chl ro b=0 ref'))
        call ToPIPE('GE', 'label weiw=0 gt="'TextColor$':" ua ref')
        call AssignID('GE_TextColorGad', ToPIPE('GE', 'Button chl gt="'Color.AddEvent'" ref'))
        call ToPIPE('GE', 'label weiw=0 gt="'Line$':" ua ref')
        call AssignID('GE_LineGad', ToPIPE('GE', 'chooser chl pu weiw=0 s=1 maxn='LineList.Count' cl='LineList' ref'))
        call ToPIPE('GE', 'label weiw=0 gt="'Boxed$':" ua ref')
        call AssignID('GE_BoxedGad', ToPIPE('GE', 'checkbox weiw=0 chl ref'))
        call ToPIPE('GE', 'label weiw=0 gt="'BoxColor$':" ua ref')
        call AssignID('GE_BoxColorGad', ToPIPE('GE', 'Button chl gt="'Background.AddEvent'" ref'))
        call ToPIPE('GE', 'label weiw=0 gt="'Frequency$':" ua ref')
        call AssignID('GE_FrequencyGad', ToPIPE('GE', 'chooser chl pu weiw=0 maxn=3 cl='FrequencyList' ref'))
      call ToPIPE('GE', 'le')
      call ToPIPE('GE', 'layout v si e cj b=0')
        call ToPIPE('GE', 'layout si e weiw=0 b=0')
          call AssignID('GE_OKGad', ToPIPE('GE', 'button weiw=0 weih=0 gt="'OK$'" ref'))
          call AssignID('GE_CancelGad', ToPIPE('GE', 'button weiw=0 weih=0 c gt="'Cancel$'" ref'))
          call AssignID('GE_UndoGad', ToPIPE('GE', 'button weiw=0 weih=0 dis=1 gt="'Undo$'" ref'))
        call ToPIPE('GE', 'le')
      call ToPIPE('GE', 'le')
    call ToPIPE('GE', 'le')
  call ToPIPE('GE', 'le')

  GetFileAllGad = ToPIPE('GE', 'getfile ua pat="#?"')
  GetFileDataGad = ToPIPE('GE', 'getfile ua pat="'PatVar'"')

  if App == 'PGS' then do
    call open('FontReq', "awnpipe:FontReq/xc")
    call ToPIPE('FontReq', '"'SelectFont$'" m db dg v a ps="'AppScreen'"')
    call ToPIPE('FontReq', 'listbrowser minw=200 minh=300')
    do GE_FontNumber = 0 to FontList.COUNT - 1
      GadID = ToPIPE('FontReq', 'browsernode gt="'FontList.GE_FontNumber'" ref')
      interpret 'FontGad.'GadID' = 'GE_FontNumber
    end
  end

  call open('ColorReq','awnpipe:ColorReq/xc')
  call ToPIPE('ColorReq','"Select color:" m db dg v a ps="'AppScreen'"')
  call ToPIPE('ColorReq','listbrowser minw 150 minh 75 lbl "Color|Sample" ref')

  call open('NCColorReq','awnpipe:NCColorReq/xc')
  call ToPIPE('NCColorReq','"Select color:" m db dg v a ps="'AppScreen'"')
  call ToPIPE('NCColorReq','listbrowser minw 150 minh 75 lbl "Color|Sample" ref')

  if App == 'FW' then do
    do GE_ColorNumber = 0 to ColorList.Count - 2
      if UpdateBusy(Req, 1) == -1 then call Cleanup
      RPen = dTox(x2d(left(ColorRegister.GE_ColorNumber, 2)) / 255 * 4294967295)
      GPen = dTox(x2d(substr(ColorRegister.GE_ColorNumber, 3, 2)) / 255 * 4294967295)
      BPen = dTox(x2d(right(ColorRegister.GE_ColorNumber, 2)) / 255 * 4294967295)

      call ToPIPE('ColorReq','penmap pmp 1|'RPen'|'GPen'|'BPen' pmd 0|'d2x(ColorW)'|0|'d2x(ColorH)''copies('|0', ColorW * ColorH))
      GadID = ToPIPE('ColorReq','browsernode gt="'ColorList.GE_ColorNumber'|¶" ref')
      interpret 'ColorGad.'GadID' = 'GE_ColorNumber

      call ToPIPE('NCColorReq','penmap pmp 1|'RPen'|'GPen'|'BPen' pmd 0|'d2x(ColorW)'|0|'d2x(ColorH)''copies('|0', ColorW * ColorH))
      GadID = ToPIPE('NCColorReq','browsernode gt="'ColorList.GE_ColorNumber'|¶" ref')
      interpret 'NCColorGad.'GadID' = 'GE_ColorNumber
    end
    GadID = ToPIPE('ColorReq','browsernode gt="<'Clear$'>|¶" ref')
    interpret 'ColorGad.'GadID' = 'GE_ColorNumber
  end
  else if App == 'PGS' then do
    do GE_ColorNumber = 0 to ColorList.Count - 2
      if UpdateBusy(Req, 1) == -1 then call Cleanup
      GadID = ToPIPE('ColorReq','browsernode gt="'ColorList.GE_ColorNumber'|" ref')
      interpret 'ColorGad.'GadID' = 'GE_ColorNumber
      GadID = ToPIPE('NCColorReq','browsernode gt="'ColorList.GE_ColorNumber'|" ref')
      interpret 'NCColorGad.'GadID' = 'GE_ColorNumber
    end
    GadID = ToPIPE('ColorReq','browsernode gt="<'Clear$'>|" ref')
    interpret 'ColorGad.'GadID' = 'GE_ColorNumber
  end

/**/

  /***//*** GUI Action Loop ***/
  call ToPIPE('GE', 'open')
  call UpdateBusy(Req, 1)

  call CloseBusy('ProgReq')

  do until eof('GE')
    call ToPIPE('GE', 'continue')
    GE_EventInfo = readln('GE')
    parse var GE_EventInfo GE_Event' 'GE_GadID' 'GE_GadInfo1
    select
    /***//*** close ***/
      when GE_Event == 'close' then call Cleanup
    /**/

    /***//*** Help event ***/
      when GE_Event == 'help' then do
        if GE_GadID ~= -1 then OverGad = GE_GadID
      end
    /**/

    /***//*** Key event ***/
      when GE_Event == 'key' then do
        HelpGad = GE_Help.OverGad
        interpret 'HelpText = Help$.'HelpGad
        if (GE_GadID == 95) & (symbol('Help$.'HelpGad) == 'VAR') then
          call CASimpleReq(Help$, HelpText, HelpTime)
      end
    /**/

    /***//*** GE_EventTypeGad ***/
      when GE_GadID == GE_EventTypeGad then do
        GE_EventType = GE_Type.GE_GadInfo1
        interpret 'GE_EventValue = GE_Store'GE_EventType'$'
        GE_StartOrEnd = 1
        if GE_EventType == Event$ then GE_DisableFlag = 0
        else do
          GE_DisableFlag = 1
          call ToPIPE('GE', 'id 'GE_EndGad' gt="" ref')
        end
        call ToPIPE('GE', 'id 'GE_EventGad' gt="'GE_EventValue'" ref')
        call ToPIPE('GE', 'id 'GE_ChooseFileGad' dis='1-GE_DisableFlag' ref')
        call ToPIPE('GE', 'id 'GE_FontNameGad' dis='GE_DisableFlag' ref')
        call ToPIPE('GE', 'id 'GE_FontSizeGad' dis='GE_DisableFlag' ref')
        call ToPIPE('GE', 'id 'GE_ChooseFontGad' dis='GE_DisableFlag' ref')
        call ToPIPE('GE', 'id 'GE_ResetGad' dis='GE_DisableFlag' ref')
        call ToPIPE('GE', 'id 'GE_TextColorGad' dis='GE_DisableFlag' ref')
        call ToPIPE('GE', 'id 'GE_LineGad' dis='GE_DisableFlag' ref')
        call ToPIPE('GE', 'id 'GE_BoxedGad' dis='GE_DisableFlag' ref')
        call ToPIPE('GE', 'id 'GE_BoxColorGad' dis='GE_DisableFlag' ref')
        call ToPIPE('GE', 'id 'GE_FrequencyGad' dis='GE_DisableFlag' ref')
      end
    /**/

    /***//*** GE_EventGad ***/
      when GE_GadID == GE_EventGad then do
        GE_EventValue = GE_GadInfo1
        interpret 'GE_Store'GE_EventType'$ = GE_EventValue'
      end
    /**/

    /***//*** GE_ChooseFileGad ***/
      when GE_GadID == GE_ChooseFileGad then do
        if GE_EventType == Image$ then do
          address command 'assign >NIL: FWC: 'ScriptDir'Images/'
          if RC == 20 then GE_Dir = ScriptDir
          else do
            GE_Dir = ScriptDir'Images/'
            address command 'assign >NIL: FWC:'
          end
          GE_EventFile = CAGetFile('GE', GetFileAllGad, SelectImage$, GE_Dir)
        end
        else do
          GE_EventFile = CAGetFile('GE', GetFileDataGad, SelectFile$, PathPart(PrefsFile)'FWCAddEvent.data')
        end

        if GE_EventFile ~= '' then do
          if ~exists(GE_EventFile) then do
            call ToPIPE('GE', 'id 0 s=256')
            call CASimpleReq('FWCAddEvent 'Notice$, GE_EventFile' 'CantFind$'...')
            call ToPIPE('GE', 'id 0 s=512')
            GE_EventFile = ''
          end
          else do
            GE_EventValue = GE_EventFile
            interpret 'GE_Store'GE_EventType'$ = GE_EventValue'
            call ToPIPE('GE', 'id 'GE_EventGad' gt="'GE_EventValue'" ref')
          end
        end
      end
    /**/

    /***//*** GE_FontNameGad ***/
      when GE_GadID == GE_FontNameGad then do
        call ToPIPE('GE', 'id 0 s=256')
        call CASimpleReq('FWCalendar 'Notice$, MustUse$)
        call ToPIPE('GE', 'id 0 s=512')
        call ToPIPE('GE', 'id 'GE_FontNameGad' gt="'FontName'" ref')
      end
    /**/

    /***//*** GE_FontSizeGad ***/
      when GE_GadID == GE_FontSizeGad then do
        interpret 'Value = 'GE_GadInfo1
        if datatype(Value) == 'NUM' then FontSize = round(Value, 4)
        call ToPIPE('GE', 'id 'GE_FontSizeGad' gt="'FontSize'" ref')
      end
    /**/

    /***//*** GE_ChooseFontGad ***/
      when GE_GadID == GE_ChooseFontGad then do
        if App == 'FW' then do
          GE_File = CAGetFile('GE', GetFileAllGad, SelectFont$, CurrentDir'FWFonts/SWOLFonts/')
          if GE_File ~= '' then do
            FontName = GE_File
            call ToPIPE('GE', 'id 'GE_FontNameGad' gt="'FontName'" ref')
          end
        end
        else if App == 'PGS' then do
          call ToPIPE('GE', 'id 0 s=256')
            FontName = ReadBrowserList('FontReq', 'FontGad', 'FontList', FontName)
            call ToPIPE('GE', 'id 'GE_FontNameGad' gt="'FontName'" ref')
          call ToPIPE('GE', 'id 0 s=512')
        end
      end
    /**/

    /***//*** GE_ResetGad ***/
      when GE_GadID == GE_ResetGad then do
        FontName = Font.Highlight
        FontSize = FSize.Highlight
        call ToPIPE('GE', 'id 'GE_FontNameGad' gt="'FontName'"')
        call ToPIPE('GE', 'id 'GE_FontSizeGad' gt="'FontSize'"')
      end
    /**/

    /***//*** Date Gadgets ***/
      when GadArg.GE_GadID ~= '' then do
        if GE_EventType == File$ then GE_StartOrEnd = 0
        else GE_StartOrEnd = 1 - GE_StartOrEnd
        GE_ReturnDate = strip(left(GadArg.GE_GadID, 1)''right(GadArg.GE_GadID, 2), "B", "C")
        GE_Date = substr(GadArg.GE_GadID, 2)
        if GE_StartOrEnd == 0 then do
          call ToPIPE('GE', 'id 'GE_StartGad' gt="'GE_Date'" ref')
          GE_StartDate = GE_ReturnDate
        end
        else do
          call ToPIPE('GE', 'id 'GE_EndGad' gt="'GE_Date'" ref')
          GE_EndDate = GE_ReturnDate
        end
      end
    /**/

    /***//*** GE_TextColorGad ***/
      when GE_GadID == GE_TextColorGad then do
        call ToPIPE('GE', 'id 0 s=256')
        GE_TextColor = ReadBrowserList('NCColorReq', 'NCColorGad', 'ColorList')
        call ToPIPE('GE', 'id 'GE_TextColorGad' gt="'GE_TextColor'"')
        call ToPIPE('GE', 'id 0 s=512')
      end
    /**/

    /***//*** GE_LineGad ***/
      when GE_GadID == GE_LineGad then GE_EnteredLine = GE_GadInfo1
    /**/

    /***//*** GE_BoxedGad ***/
      when GE_GadID == GE_BoxedGad then GE_BoxValue = GE_Boxed.GE_GadInfo1
    /**/

    /***//*** GE_BoxColorGad ***/
      when GE_GadID == GE_BoxColorGad then do
        call ToPIPE('GE', 'id 0 s=256')
        GE_BoxColor = ReadBrowserList('ColorReq', 'ColorGad', 'ColorList')
        call ToPIPE('GE', 'id 'GE_BoxColorGad' gt="'GE_BoxColor'"')
        call ToPIPE('GE', 'id 0 s=512')
      end
    /**/

    /***//*** GE_FrequencyGad ***/
      when GE_GadID == GE_FrequencyGad then GE_WeeklyValue = GE_Weekly.GE_GadInfo1
    /**/

    /***//*** GE_UndoGad ***/
      when GE_GadID == GE_UndoGad then do
        call ToPIPE('GE', 'id 0 s=128')
          do GE_i = 1 to Undo.UndoLevel.0
            if App == 'FW' then DELETEOBJECT Undo.UndoLevel.GE_i
            else if App == 'PGS' then do
              SELECTOBJECT OBJECTID Undo.UndoLevel.GE_i WINDOW winName
              DELETEOBJECT OBJECTID Undo.UndoLevel.GE_i WINDOW winName
            end
          end
          UndoLevel = UndoLevel - 1
          if UndoLevel == 0 then UndoStatus = 1
          else UndoStatus = 0
          call ToPIPE('GE', 'id 'GE_UndoGad' dis='UndoStatus' ref')
        call ToPIPE('GE', 'id 0 s=64')
      end
    /**/

    /***//*** GE_OKGad ***/
      when GE_GadID == GE_OKGad then do
        call writeln('GE', 'id 'GE_EventGad' read')
        GE_EventValue = readln('GE')
        call writeln('GE', 'id 'GE_FontSizeGad' read')
        FontSize = readln('GE')
        if (GE_StartDate == "") & (GE_EventType == Event$) then do
          call ToPIPE('GE', 'id 0 s=256')
          call CASimpleReq('FWCAddEvent 'Notice$, EnterStartDate$'...')
          call ToPIPE('GE', 'id 0 s=512')
        end
        else if (GE_EventValue == "") & (GE_BoxValue == "") then do
          call ToPIPE('GE', 'id 0 s=256')
          call CASimpleReq('FWCAddEvent 'Notice$, EnterEvent$'...')
          call ToPIPE('GE', 'id 0 s=512')
        end
        else do
          EventData = "   EventType = "GE_EventType||'0a'x||,
                      " EnteredDay1 = "strip(GE_StartDate)||'0a'x||,
                      " EnteredDay2 = "strip(GE_EndDate)||'0a'x||,
                      "   TextColor = "GE_TextColor||'0a'x||,
                      " EnteredLine = "GE_EnteredLine||'0a'x||,
                      "    BoxColor = "GE_BoxColor||'0a'x||,
                      "     Options = "GE_BoxValue""GE_WeeklyValue||'0a'x||,
                      " EnteredFont = "strip(FontName)||'0a'x||,
                      " EnteredSize = "strip(FontSize)||'0a'x||,
                      "EnteredEvent = "GE_EventValue
          call ToPIPE('GE', 'id 0 s=128')
          call ProcessEvent
          call ToPIPE('GE', 'id 0 s=64')

          if UndoLevel == 0 then UndoStatus = 1
          else UndoStatus = 0
          call ToPIPE('GE', 'id 'GE_UndoGad' dis='UndoStatus' ref')

          GE_StartOrEnd = 1
          GE_StartDate  = ""
          GE_EndDate    = ""
          call ToPIPE('GE', 'id 'GE_StartGad' gt="" ref')
          call ToPIPE('GE', 'id 'GE_EndGad' gt="" ref')
        end
      end
    /**/

      otherwise nop
    end
  end
/**/
  exit
/**/

/***//*** GetFontWidth (GFW) Subroutine ***/
GetFontWidth:
  parse arg GFW_FontType, GFW_Char

  GFW_ID = PrintText(1, 1, GFW_FontType, 'N', White$, Width.GFW_FontType, GFW_Char)
  if App == 'FW' then do
    REDRAW
    GETOBJECTCOORDS GFW_ID; parse var RESULT . . . GFW_Width .
    DELETEOBJECT GFW_ID
  end
  else if App == 'PGS' then do
    GETTEXTOBJ POSITION GFW_Text OBJECTID GFW_ID WINDOW winName
    GFW_Width = GFW_Text.Right - GFW_Text.Left
    DELETEOBJECT OBJECTID GFW_ID WINDOW winName
  end
return GFW_Width
/**/

/***//*** GetHeight (GH) Subroutine ***/
GetHeight:
  parse arg GH_FontType

  if App == 'FW' then do
    TEXTBLOCKTYPEPREFS SIZE FSize.GH_FontType FONT Font.GH_FontType
    DRAWTEXTBLOCK 1 1 1 'A'; GH_id = result
    GETOBJECTCOORDS GH_id; Parse Var result . . . . GH_Text.Height
    DELETEOBJECT GH_id
  end
  else if App == 'PGS' then do
    DRAWTEXTOBJ 0 0 WINDOW winName; GH_id = result
    SELECTTEXT AT 0 0 WINDOW winName
    BEGINCOMMANDCAPTURE
      SETLEADING RELATIVE 100
      SETTYPESIZE FSize.GH_FontType WINDOW winName
      SETFONT Font.GH_FontType WINDOW winName
    ENDCOMMANDCAPTURE
    INSERT 'A' WINDOW winName
    GETTEXTOBJ POSITION GH_Text OBJECTID GH_id WINDOW winName
    GH_Text.Height = GH_Text.Bottom - GH_Text.Top
    DELETEOBJECT OBJECTID GH_id WINDOW winName
  end
  return GH_Text.Height
/**/

/***//*** GetID (GI) Subroutine ***/
GetID:
parse arg GI_var

return id.GI_var
/**/

/***//*** GetImageInfo (GII) ***/
GetImageInfo:
  parse arg GII_ImageNumber

  if ImageType.GII_ImageNumber == '' then do
    ImageFile.GII_ImageNumber = strip(ImageFile.GII_ImageNumber, 'B', '" '||"'")
    parse var ImageFile.GII_ImageNumber ImageFile.GII_ImageNumber ',' ImageDX.GII_ImageNumber ',' ImageDY.GII_ImageNumber
    ImageDX.GII_ImageNumber = strip(ImageDX.GII_ImageNumber, 'B', '" '||"'");if ImageDX.GII_ImageNumber == '' then ImageDX.GII_ImageNumber = 0
    ImageDY.GII_ImageNumber = strip(ImageDY.GII_ImageNumber, 'B', '" '||"'");if ImageDY.GII_ImageNumber == '' then ImageDY.GII_ImageNumber = 0
    if (pos('/', ImageFile.GII_ImageNumber) == 0) & (pos(':', ImageFile.GII_ImageNumber) == 0) then
      ImageFile.GII_ImageNumber = ScriptDir'Images/'strip(ImageFile.GII_ImageNumber, 'B', ' "'||"'")
    if upper(GfxApp) == 'FWCALENDAR' then call WriteFile('PIPE:FWC', ParseImage(ImageFile.GII_ImageNumber))
    else do
      GII_Cmd = Storage''GfxApp' >PIPE:FWC '
      GII_InsertPos = pos('%s', GfxCmd)
      GII_Cmd = GII_Cmd''left(GfxCmd, GII_InsertPos - 1)''ImageFile.GII_ImageNumber''substr(GfxCmd, GII_InsertPos + 2)
      address command GII_Cmd
    end

    GII_Template = GfxTemplate
    GII_InfoLine = ReadFile('PIPE:FWC')
    if GII_InfoLine ~= '' then do
      interpret "parse var GII_InfoLine "GII_Template
      GII_ImageType = upper(strip(ImgDT))
      ImageWidth.GII_ImageNumber = strip(ImgWidth) / 72
      ImageHeight.GII_ImageNumber = strip(ImgHeight) / 72
      if (datatype(GII_ImageType) ~= 'CHAR') | (datatype(ImageWidth.GII_ImageNumber) ~= 'NUM') | (datatype(ImageHeight.GII_ImageNumber) ~= 'NUM') then do
        call AddMsg('W', GII_InfoLine)
        return 0
      end
      else do
        if (GII_ImageType == 'POST') | (GII_ImageType == 'POSTSCRIPT') then do
          call open('File', ImageFile.GII_ImageNumber)
            GII_FileInfo = readch('File', 15)
            if left(GII_FileInfo, 14) == '%!PS-Adobe-3.0' then GII_ImageType = 'EPS'
            else GII_ImageType = 'POST'
          call close('File')
        end
        else if (GII_ImageType == 'WINDOWS BITMAP') | (GII_ImageType == 'WIND') then GII_ImageType = 'BMP'
        ImageType.GII_ImageNumber = GII_ImageType
        if PGSFilter.GII_ImageType == '' then PGSFilter.GII_ImageNumber = GII_ImageType
        else PGSFilter.GII_ImageNumber = PGSFilter.GII_ImageType
      end
    end
    else do
      call AddMsg('W', 'Unable to process 'ImageFile.GII_ImageNumber)
      return 0
    end
  end

  return 1
/**/

/***//*** GetWidth (GW) Subroutine ***/
GetWidth:
  parse arg GW_ID

  if App = 'FW' then do
    GETOBJECTCOORDS GW_ID
    Parse Var result . . . GW_width .
  end
  else if App == 'PGS' then do
    SELECTOBJECT OBJECTID GW_ID  WINDOW winName
    GETOBJECT BOUNDINGBOX GW_Temp WINDOW winName
    GW_width = GW_Temp.Right - GW_Temp.Left
  end

  return GW_width
/**/

/***//*** InsertImage (II) ***/
InsertImage:
  parse arg II_ImageNumber, II_CenterX, II_CenterY, II_MaxWidth, II_MaxHeight, II_FixRatio

  if GoodImage.II_ImageNumber == 0 then return 0

  if ImageType.II_ImageNumber == '' then GoodImage.II_ImageNumber = GetImageInfo(II_ImageNumber)
  if ImageType.II_ImageNumber ~= '' then do
    II_ImageWidth = ImageWidth.II_ImageNumber
    II_ImageHeight = ImageHeight.II_ImageNumber
    if (II_MaxWidth > 0) & (II_MaxHeight > 0) then do
      if II_FixRatio == 1 then do
        if (II_ImageWidth > II_MaxWidth) | (II_ImageHeight > II_MaxHeight) then do
          EnlFactor = min(II_MaxWidth / II_ImageWidth, II_MaxHeight / II_ImageHeight)
          II_ImageWidth  = II_ImageWidth * EnlFactor
          II_ImageHeight = II_ImageHeight * EnlFactor
        end
      end
      else do
        if II_MaxWidth > 0 then II_ImageWidth  = II_ImageWidth * (II_MaxWidth / II_ImageWidth)
        if II_MaxHeight > 0 then II_ImageHeight = II_ImageHeight * (II_MaxHeight / II_ImageHeight)
      end
    end
    II_Image.Left = II_CenterX - II_ImageWidth/2 + ImageDX.II_ImageNumber
    II_Image.Top  = II_CenterY - II_ImageHeight/2 + ImageDY.II_ImageNumber
    if App == 'FW' then do
      INSERTIMAGE ImageFile.II_ImageNumber POSITION 1 II_Image.Left II_Image.Top II_ImageWidth II_ImageHeight
      ImageID.Day = result
      OBJECTTOBACK ImageID.Day
    end
    else if App == 'PGS' then do
      if pos(upper('|'PGSFilter.II_ImageNumber'|'), PGSRecognizedFormats) ~= 0 then do
        PLACEGRAPHIC FILE ImageFile.II_ImageNumber FILTER PGSFilter.II_ImageNumber AT II_Image.Left II_Image.Top WINDOW winName
        ImageID.Day = result
        if PGSFilter.II_ImageNumber == 'IllustratorEPS' then EDITDRAWING POSITION II_Image.Left II_Image.Top (II_Image.Left + II_ImageWidth) (II_Image.Top + II_ImageHeight) OBJECTID ImageID.Day WINDOW winName
        else EDITPICTURE POSITION II_Image.Left II_Image.Top (II_Image.Left + II_ImageWidth) (II_Image.Top + II_ImageHeight) OBJECTID ImageID.Day WINDOW winName
        SENDTOBACK OBJECTID ImageID.Day WINDOW winName
      end
    end
  end

  return ImageID.Day
/**/

/***//*** MemberID (MI) ***/
MemberID:
  parse arg MI_Member, MI_Array, MI_Count, MI_Start

  if MI_Count == '' then interpret 'MI_Count = 'MI_Array'.Count'
  if MI_Start == '' then do
    if symbol(MI_Array'.Start') == 'VAR' then interpret 'MI_Start = 'MI_Array'.Start'
    else MI_Start = 0
  end

  do MI_i = MI_Start to MI_Start + MI_Count - 1
    if upper(value(MI_Array'.'MI_i)) == upper(MI_Member) then return MI_i
  end
  return -1
/**/

/***//*** NameOnly (PROCEDURE) ***/
NameOnly: PROCEDURE
  parse arg FileWithPath
  return substr(FileWithPath, max(lastpos(':', FileWithPath), lastpos('/', FileWithPath)) + 1)
/**/

/***//*** ParseImage (PROCEDURE) ***/
ParseImage: PROCEDURE
  parse arg FileName

  BytesRead = 1000
  call open('File', FileName)
    FileInfo = readch('File', BytesRead)

    Dimensions = 0
    XSize = 0
    YSize = 0
    Select
      when left(FileInfo, 2) == 'BM' then Dimensions = DoBMP()
      when left(FileInfo, 4) == 'FORM' then Dimensions = DoIFF()
      when left(FileInfo, 3) == 'GIF' then Dimensions =  DoGIF()
      when left(FileInfo, 10) == '%!PS-Adobe' then Dimensions = DoPS()
      when left(FileInfo, 5) == x2c(C5D0D3C61E) then Dimensions = DoPS()
      when left(FileInfo, 4) == x2c(0A050108) then Dimensions = DoPCX()
      when left(FileInfo, 4) == x2c(4D4D002A) then Dimensions = DoTIFF(1)
      when left(FileInfo, 4) == x2c(49492A00) then Dimensions = DoTIFF(2)
      when substr(FileInfo, 2, 3) == 'PNG' then Dimensions = DoPNG()
      when substr(FileInfo, 7, 4) == 'JFIF' then Dimensions = DoJPEG()
      when substr(FileInfo, 9, 4) == x2c(00000763) then Dimensions = DoTarga()
      otherwise FileType = 'Unknown'
    end
    if Dimensions ~= 0 then parse var Dimensions XSize'x'YSize
  call close('File')
  return FileType' 'XSize' 'YSize

/* Format Routines */
/***//** BMP **/
DoBMP:
  FileType = 'BMP'
  XSize = x2d(c2x(substr(FileInfo, 21, 1)||substr(FileInfo, 20, 1)||substr(FileInfo, 19, 1)))
  YSize = x2d(c2x(substr(FileInfo, 25, 1)||substr(FileInfo, 24, 1)||substr(FileInfo, 23, 1)))
  return XSize'x'YSize
/**/

/***//** EPS **/
DoEPS:
  FileType = 'EPS'
  BoundingBoxLn = ReadToEOL(pos('%%BoundingBox:', FileInfo), FileInfo)
  BoundingBox = substr(BoundingBoxLn, pos(':', BoundingBoxLn) + 1)
  XSize = word(BoundingBox, 3) - word(BoundingBox, 1) + 1
  YSize = word(BoundingBox, 4) - word(BoundingBox, 2) + 1

  return XSize'x'YSize
/**/

/***//** GIF **/
DoGIF:
  if (left(FileInfo, 6) == 'GIF89a') | (left(FileInfo, 6) == 'GIF87a')then do
    FileType = 'GIF'
    XSize = x2d(c2x(substr(FileInfo, 8, 1)||substr(FileInfo, 7, 1)))
    YSize = x2d(c2x(substr(FileInfo, 10, 1)||substr(FileInfo, 9, 1)))
    return XSize'x'YSize
  end
  return 0
/**/

/***//** IFF **/
DoIFF:
  SubType  = substr(FileInfo, 9, 4)
  FileType = 'IFF'SubType

  if pos(SubType, 'ILBM|DEEP|RGBN|RGB8') > 0 then do
    OffSet = pos('BMHD', FileInfo)
    if OffSet == 0 then OffSet = pos('DGBL', FileInfo)
    if OffSet > 0 then do
      XSize = x2d(c2x(substr(FileInfo, OffSet + 8, 2)))
      YSize = x2d(c2x(substr(FileInfo, OffSet + 10, 2)))
      return XSize'x'YSize
    end
  end
  return 0
/**/

/***//** JPEG **/
DoJPEG:
  FileType = 'JPEG'
  Offset = x2d(c2x(substr(FileInfo, 5, 2))) + 7
  if x2d(c2x(substr(FileInfo, Offset, 1))) ~= 0 then do
    Offset = x2d(c2x(substr(FileInfo, 23, 2))) + 25
    if Offset > BytesRead then do
      BytesRead = BytesRead + Offset
      FileInfo = FileInfo||readch('File', Offset)
    end

    Offset = x2d(c2x(substr(FileInfo, Offset, 2))) + Offset
    if Offset > BytesRead then do
      BytesRead = BytesRead + Offset
      FileInfo = FileInfo||readch('File', Offset)
    end
  end

  Offset = pos(x2c(001108), FileInfo, Offset)
  if Offset == 0 then Offset = pos(x2c(001108), FileInfo, Offset)
  if Offset > 0 then do
    YSize = x2d(c2x(substr(FileInfo, Offset+3, 2)))
    XSize = x2d(c2x(substr(FileInfo, Offset + 5, 2)))
    return XSize'x'YSize
  end

  return 0
/**/

/***//** PCX **/
DoPCX:
  FileType = 'PCX'
  XSize = x2d(c2x(substr(FileInfo, 14, 1)||substr(FileInfo, 13, 1)))
  YSize = x2d(c2x(substr(FileInfo, 16, 1)||substr(FileInfo, 15, 1)))
  return XSize'x'YSize
/**/

/***//** PNG **/
DoPNG:
  FileType = 'PNG'
  OffSet = pos('IHDR', FileInfo)
  if Offset > 0 then do
    XSize = x2d(c2x(substr(FileInfo, Offset + 6, 2)))
    YSize = x2d(c2x(substr(FileInfo, Offset + 10, 2)))
    return XSize'x'YSize
  end
  return 0
/**/

/***//** PS **/
DoPS:
  FileType = 'POST'
  BoundingBoxLn = ReadToEOL(pos('%%BoundingBox:', FileInfo), FileInfo)
  BoundingBox = substr(BoundingBoxLn, pos(':', BoundingBoxLn) + 1)
  if datatype(word(BoundingBox, 1)) ~= 'NUM' then return 0
  XSize = word(BoundingBox, 3) - word(BoundingBox, 1) + 1
  YSize = word(BoundingBox, 4) - word(BoundingBox, 2) + 1

  return XSize'x'YSize
/**/

/***//** Targa **/
DoTarga:
  FileType = 'TARGA'
  XSize = x2d(c2x(substr(FileInfo, 14, 1)||substr(FileInfo, 13, 1)))
  YSize = x2d(c2x(substr(FileInfo, 16, 1)||substr(FileInfo, 15, 1)))
  return XSize'x'YSize
/**/

/***//** TIFF **/
DoTIFF:
  parse arg TIFFType
  FileType = 'TIFF'
  if TIFFType == 1 then do
    XSize = x2d(c2x(substr(FileInfo, 21, 2)))
    YSize = x2d(c2x(substr(FileInfo, 33, 2)))
  end
  else do
    XSize = x2d(c2x(substr(FileInfo, 22, 1)||substr(FileInfo, 21, 1)))
    YSize = x2d(c2x(substr(FileInfo, 34, 1)||substr(FileInfo, 33, 1)))
  end
  return XSize'x'YSize
/**/
/**/

/***//*** ParseVariables (PV) Subroutine ***/
ParseVariables:
  parse arg PV_Line

  PV_String = translate(PV_Line,,'=(+-*/,)"'||"'",' ')
  PV_VarString = ''
  PV_Var.      = '00'x
  PV_LongVar   = 4
  PV_LIT       = ''
  PV_Count     = 0

  do PV_i = 1 to words(PV_String)
    PV_Word = word(PV_String, PV_i)
    if pos(PV_Word'(', PV_Line) > 0 then iterate
    if datatype(PV_Word) == 'CHAR' then do
      if symbol(PV_Word) == 'LIT' then PV_LIT = PV_LIT''PV_Word', '
      if symbol(PV_Word) == 'VAR' then do
        PV_LongVar = max(PV_LongVar, length(PV_Word) + 2)
        if PV_Var.PV_Word == '00'x then do
          PV_Count = PV_Count + 1
          PV_Var.PV_Count = PV_Word
          PV_Var.PV_Word  = value(PV_Word)
        end
        if pos('.', PV_Word) > 0 then do
          PV_CompoundParts = subword(translate(PV_Word,,'.', ' '), 2)
          do PV_j = 1 to words(PV_CompoundParts)
            PV_Subword = word(PV_CompoundParts, PV_j)
            if PV_Var.PV_SubWord == '00'x then do
              PV_Count = PV_Count + 1
              PV_Var.PV_Count = PV_SubWord
              if symbol(PV_Subword) == 'LIT' then PV_Var.PV_SubWord  = 'LIT'
              else PV_Var.PV_SubWord  = value(PV_SubWord)
            end
          end
        end
      end
    end
  end

  do PV_i = 1 to PV_Count
    PV_Word = PV_Var.PV_i
    if length(PV_Var.PV_Word) > 50 then PV_Var.PV_Word = left(PV_Var.PV_Word, 50)'...'
    PV_Var.PV_Word = translate(PV_Var.PV_Word,,'0a'x||'0d'x||'00'x,'bb'x)
    PV_VarString = PV_VarString''right(PV_Word, PV_LongVar)' = 'PV_Var.PV_Word||'0a'x
  end

  if PV_LIT ~= '' then PV_VarString = right('LIT', PV_LongVar)' = 'strip(PV_LIT, 'B', ' ,')||'0a'x||PV_VarString

  return PV_VarString
/**/

/***//*** PathPart (PROCEDURE) ***/
PathPart: PROCEDURE
  parse arg FileWithPath
  return left(FileWithPath, max(lastpos(':', FileWithPath), lastpos('/', FileWithPath)))
/**/

/***//*** PgmVer (PROCEDURE) ***/
PgmVer: PROCEDURE
  parse arg Program

  address command 'version 'Program '>PIPE:FWC file'

  return strip(word(ReadFile('PIPE:FWC'), 2))
/**/

/***//*** PrintText (PT) Subroutine ***/
PrintText:
  parse arg PT_Left, PT_Top, PT_FontType, PT_Style, PT_Color, PT_Width, PT_Text

  if upper(PT_Style) == 'N' then PT_Font = Font.PT_FontType
  else PT_Font = Bold.PT_FontType

  if App == 'FW' then do
    if left(PT_Text, 1) == '"' then PT_Text = '""'PT_Text
    PT_Top = PT_Top + TextAdj * Height.PT_FontType
    TEXTBLOCKTYPEPREFS SIZE FSize.PT_FontType WIDTH trunc(PT_Width) COLOR '"'PT_Color'"' FONT PT_Font
    DRAWTEXTBLOCK 1 PT_Left PT_Top PT_Text; PT_id = result
  end
  else if App == 'PGS' then do
    DRAWTEXTOBJ PT_Left PT_Top WINDOW winName; PT_id = result
    SELECTTEXT AT PT_Left PT_Top WINDOW winName
    BEGINCOMMANDCAPTURE
      SETLEADING RELATIVE 100
      SETTYPESIZE FSize.PT_FontType WINDOW winName
      SETTYPEWIDTH PT_Width WINDOW winName
      SETFONT PT_Font WINDOW winName
      SETCOLORSTYLE '"'PT_Color'"' COLORNUMBER 0 FILL TEXT WINDOW winName
    ENDCOMMANDCAPTURE
    if pos('"', PT_Text) > 0 then do
      call WriteFile('PIPE:Text2Insert.txt', PT_Text)
      INSERTTEXT FILE 'PIPE:Text2Insert.txt' FILTER ASCII WINDOW winName
    end
    else INSERT '"'PT_Text'"' WINDOW winName
  end
  return PT_id
/**/

/***//*** ProcessEvent (PE) Subroutine ***/
ProcessEvent:
  UndoLevel = UndoLevel + 1
  UndoItem = 0
  EnteredLine = 1
  WindowRefreshed = 0
  Keywords = '|FONT|SIZE|START|END|LINE|PERIODICBASE|INTERVAL|DURATION|EVENT|EVENTTYPE|OPTIONS|TEXTCOLOR|BOXCOLOR|ENTEREDFONT|ENTEREDSIZE|ENTEREDDAY1|ENTEREDDAY2|ENTEREDLINE|ENTEREDEVENT|'
  PE_Keywords = '|PERIODICBASE|INTERVAL|DURATION|'

  if EventData == 0 then call CleanUp
  call openv('EventData')
    do until eofv('EventData')
      PE_Ln = readvln('EventData')
      interpret strip(word(PE_Ln, 1))' = strip(subword(PE_Ln, 3))'
    end
  call closev('EventData')

  Event. = ''
  PeriodicEvent. = 0
  if (EventType == Event$) | (EventType == Image$) then do
    EventCount = 1
    Event.0   = EventCount
    Event.1   = EventData
    EventFile = ''
  end
  else do
    EventFile = EnteredEvent
    if EnteredDay1 == '' then EnteredDay1 = 0
    RootDay = ConvertDay(EnteredDay1)

    call open('EventFile', EventFile)
      EventCount = 1
      do until eof('EventFile')
        Ln = ReadLn('EventFile')
        if eof('EventFile') == 0 then do
          PE_Variable = upper(strip(word(Ln, 1)))
          if (pos('|'PE_Variable'|', Keywords) == 0) & (Ln ~= '') then do
            if left(Ln, 1) == '#' then do
              InternalVariable = word(Ln, 1)
              interpret InternalVariable'= strip(subword(Ln, 3))'
              InternalVariable.InternalVariable = value(InternalVariable)
            end
            else interpret Ln
            iterate
          end
          if Ln == '' then do
            if Event.1 ~= '' then EventCount = EventCount + 1
            iterate
          end
          Event.EventCount = Event.EventCount''Ln||'0a'x
          if PE_Variable == 'PERIODICBASE' then PeriodicEvent.EventCount = 1
        end
      end
      Event.0 = EventCount
    call close('EventFile')
  end

  if App == 'PGS' then do
    REFRESH OFF ALL
  end

  do EC = 1 to Event.0
    if PeriodicEvent.EC == 1 then do
      PE = Event.EC
      do EC2 = EC to Event.0 - 1
        NextEvent = EC2 + 1
        Event.EC2 = Event.NextEvent
      end
      EventCount = EventCount - 1
      PE_Ln2 = ''
      PE_Interval = ''
      PE_Duration = ''
      call openv('PE')
        do until eofv('PE')
          PE_Ln = readvln('PE')
          PE_Variable = upper(strip(word(PE_Ln, 1)))
          if pos('|'PE_Variable'|', PE_Keywords) == 0 then PE_Ln2 = PE_Ln2''PE_Ln||'0a'x
          if PE_Variable == 'PERIODICBASE' then interpret 'PE_Base = 'strip(subword(PE_Ln, 3))
          if PE_Variable == 'INTERVAL' then interpret 'Interval = 'strip(subword(PE_Ln, 3))
          if PE_Variable == 'DURATION' then interpret 'Duration = 'strip(subword(PE_Ln, 3))
        end
      call closev('PE')
      if Interval ~= '' then do
        if Duration == '' then Duration = 1
        PeriodicBase = DateInfo('I', PE_Base, 'S')
        IntervalCount = trunc((InternalStartMonth - PeriodicBase) / Interval, 0)
        do forever
          NextEvent = PeriodicBase + (IntervalCount * Interval)
          if NextEvent > InternalEndMonth then do
            leave
          end
          if NextEvent + Duration - 1 >= InternalStartMonth then do
            if (NextEvent < InternalStartMonth) & (NextEvent + Duration - 1 >= InternalStartMonth) then do
              EventCount = EventCount + 1
              Event.EventCount = 'Start = 1'||'0a'x||'End = 'Duration - (InternalStartMonth - NextEvent)||'0a'x||PE_Ln2
            end
            else if (NextEvent <= InternalEndMonth) & (NextEvent + Duration - 1 >= InternalEndMonth) then do
              EventCount = EventCount + 1
              Event.EventCount = 'Start = 'NextEvent - InternalStartMonth + 1||'0a'x||'End = 'MonthLength.Month||'0a'x||PE_Ln2
            end
            else do
              EventCount = EventCount + 1
              Event.EventCount = 'Start = 'NextEvent - InternalStartMonth + 1||'0a'x||'End = 'Duration - (InternalStartMonth - NextEvent)||'0a'x||PE_Ln2
            end
          end
          IntervalCount = IntervalCount + 1
        end
      end
      else do
        call AddMsg('W', 'Periodic event with base date 'PE_Base' does not have an associated Interval; this event set was skipped.')
        iterate EC
      end
    end
  end
  Event.0 = EventCount

  if Event.0 > 1 then Req = OpenBusy(ProcessEvents$, Event.0)
  do EC = 1 to Event.0
    if UpdateBusy(Req, 1) == -1 then call Cleanup
    Box          = 0
    Weekly       = 0
    EnteredFont  = Font.Highlight
    EnteredSize  = FSize.Highlight
    EnteredDay1  = ''
    EnteredDay2  = ''
    EnteredLine  = ''
    EnteredEvent = ''
    EventType    = ''
    PeriodicBase = ''
    Interval     = ''
    Duration     = ''
    Options      = ''
    BoxColor     = ''
    TextColor    = ''

    if Event.EC == '' then iterate
    call openv('Event.EC')
      do until eofv('Event.EC')
        PE_Ln = readvln('Event.EC')
        PE_Variable = upper(strip(word(PE_Ln, 1)))
        select
          when PE_Variable == 'FONT' then PE_Variable = 'EnteredFont'
          when PE_Variable == 'SIZE' then PE_Variable = 'EnteredSize'
          when PE_Variable == 'START' then PE_Variable = 'EnteredDay1'
          when PE_Variable == 'END' then PE_Variable = 'EnteredDay2'
          when PE_Variable == 'LINE' then PE_Variable = 'EnteredLine'
          when PE_Variable == 'EVENT' then PE_Variable = 'EnteredEvent'
          when PE_Variable == 'EVENTTYPE' then nop
          when PE_Variable == 'OPTIONS' then nop
          when PE_Variable == 'TEXTCOLOR' then nop
          when PE_Variable == 'BOXCOLOR' then nop
          when PE_Variable == 'ENTEREDFONT' then nop
          when PE_Variable == 'ENTEREDSIZE' then nop
          when PE_Variable == 'ENTEREDDAY1' then nop
          when PE_Variable == 'ENTEREDDAY2' then nop
          when PE_Variable == 'ENTEREDLINE' then nop
          when PE_Variable == 'ENTEREDEVENT' then nop
          when PE_Variable == 'COMMENT' then nop
          otherwise PE_Variable = 'Error'
        end
        if PE_Variable ~= 'Error' then do
          interpret PE_Variable'= strip(subword(PE_Ln, 3))'
          PE_Val = value(PE_Variable)
          if symbol('InternalVariable.PE_Val') == 'VAR' then interpret PE_Variable' = 'InternalVariable.PE_Val
        end
      end
    call closev('Event.EC')
    if PE_Variable == 'Error' then do
      call AddMsg('W', 'Line "'PE_Ln'" does not start with a keyword; this event set was skipped.')
      iterate EC
    end
    EnteredFont = strip(EnteredFont, 'B', '"'||"'")
    TextColor   = strip(TextColor, 'B', '"'||"'")
    BoxColor    = strip(BoxColor, 'B', '"'||"'")
    Options     = compress(upper(strip(Options, 'B', ' "'||"'")))

    if App == 'FW' then EnteredSize = max(trunc(EnteredSize), 4)

    FontInfo = compress(EnteredFont''EnteredSize, '. /:')
    if FontKnown.FontInfo == '' then do
      HighestFont = HighestFont + 1
      FontKnown.FontInfo = HighestFont
      Font.HighestFont = EnteredFont
      FSize.HighestFont = EnteredSize
      Height.HighestFont = GetHeight(HighestFont) * Leading/100
    end
    CurrentFont = FontKnown.FontInfo

    If EnteredDay2 == "" then EnteredDay2 = EnteredDay1
    If EnteredLine == '' then EnteredLine = 1
    if BoxColor    == '' then BoxColor = Background.AddEvent
    if TextColor   == '' then TextColor = Color.AddEvent

    if (EventType == Event$) | (EventType == Image$) then do
      EnteredDay1 = ConvertDay(EnteredDay1)
      EnteredDay2 = ConvertDay(EnteredDay2)
    end
    else do
      EnteredDay1 = RootDay + EnteredDay1
      EnteredDay2 = RootDay + EnteredDay2
    end
    if EnteredDay1 > EnteredDay2 then do
      TempDate = EnteredDay1
      EnteredDay1 = EnteredDay2
      EnteredDay2 = TempDate
    end

    if pos('B', Options) ~= 0 then Box = 1
    if pos('W', Options) ~= 0 then Weekly = 1
    if pos('2', Options) ~= 0 then Weekly = 2

    /* Process Event */
    if App == 'PGS' then REFRESH OFF ALL

    do until Weekly == 0
      Event = EnteredEvent
      Line  = EnteredLine
      Day1  = EnteredDay1
      Day2  = EnteredDay2
      Text. = ''

      if EventType == Image$ then do
        parse var Event PE_Image','PE_X','PE_Y
        if exists(PE_Image) then do
          do PE_ImageCounter = 1 to PE_ImageCount
            if ImageFile.PE_ImageCounter = PE_Image then leave
          end
          if PE_ImageCounter > PE_ImageCount then do
            PE_ImageCount = PE_ImageCounter
            ImageFile.PE_ImageCount = Event
          end
          PE_CurrentImage = PE_ImageCounter
        end
        else EventType = Event$
      end

      if Weekly > 0 then do
        if Day1 > MaxDate then Weekly = -1
        if Day2 > MaxDate then Day2 = MaxDate
      end

      if Weekly ~= -1 then do
        If Day1 ~= Day2 then Box = 1
        LineCount = 0
        do until Day1 > Day2
          Day1Row = trunc((Day1 + StartDate - 1) / 7)
          Day2Row = trunc((Day2 + StartDate - 1) / 7)
          Day1Column = (Day1 + StartDate) - 7 * Day1Row - 1
          Day2Column = (Day2 + StartDate) - 7 * Day2Row - 1
          if (Day1Row == 5) & (DoTopExtraWk == 1) then Day1Row = 0
          if (Day2Row == 5) & (DoTopExtraWk == 1) then Day2Row = 0

          if Day1Row == Day2Row then do
            DaySpan = Day2Column - Day1Column + 1
            NextDay1 = Day1 + DaySpan
            if (Day1Column + DaySpan - 1) > WeekdayCount then DaySpan = WeekdayCount - Day1Column + 1
          end
          else do
            DaySpan = WeekdayCount + 1 - Day1Column
            NextDay1 = Day1 + 7 - Day1Column
          end

          if Day1 < 1 then CalDate = MonthLength.PrevMonth + Day1
          else if Day1 > MonthLength.Month then CalDate = Day1 - MonthLength.Month
          else CalDate = Day1
          if DoDateBox == 1 then HighlightOffset = CurveOffset + 1.25 * DateOffset + 2 * Width.WidthOfDate8
          else do
            Select
              when CalDate < 10 then HighlightOffset = Width.WidthOfDate1 / 2 + Width.WidthOfDate8
              when CalDate < 20 then HighlightOffset = 1.5 * Width.WidthOfDate1 + Width.WidthOfDate8
              otherwise HighlightOffset = Width.WidthOfDate1 / 2 + 2 * Width.WidthOfDate8
            end
          end
          HighlightOffset = (1 - Box) * HighlightOffset * (Line * Height.Highlight < Height.Date * TextBase)
          If Day1Row < 5 then BoxTop = CalTop + Day1Row * BoxHeight
          else do
            if DoTopExtraWk ~= 1 then BoxTop = CalTop + 4.5 * BoxHeight
            else BoxTop = CalTop
          end

          if EventType == Image$ then do
            LeftEdge = Margin.Left + BoxWidth * Day1Column

            UndoItem = UndoItem + 1
            Undo.UndoLevel.UndoItem = InsertImage(PE_CurrentImage, LeftEdge + BoxWidth/2, BoxTop + BoxHeight/2, MaxImgWidth * BoxWidth, MaxImgHeight * BoxHeight, 1)
          end
          else do
            LeftEdge = Margin.Left + Day1Column * BoxWidth + CurveOffset + HighlightOffset
            if event ~= '' then do
              Textline = 0
              Text.    = ''
              Text.Textline = event

              /* Accomodate user line breaks */
              do until LineBreak = 0
                LineBreak = pos('//', Text.Textline)
                if LineBreak > 0 then do
                  Nextline = Textline + 1
                  Text.Nextline = substr(Text.Textline, LineBreak + 2)
                  Text.Textline = left(Text.Textline, LineBreak - 1)
                  Textline = Nextline
                end
              end
              Textline = 0

              /* Fit line(s) into allowable space */
              do until Text.Nextline == ''
                Nextline = Textline + 1
                if Box == 1 | Textline == 0 then Indent.Textline = 0
                else Indent.Textline = 3 * DateOffset
                AllowedWidth = DaySpan * BoxWidth - 2 * CurveOffset - Indent.Textline - HighlightOffset - 2 * DateOffset * Box
                AllowedBoxWidth = AllowedWidth + 2 * CurveOffset
                if App == 'FW' & length(Text.Textline) > 37 then do
                  Wordbreak = lastpos(' ', Text.Textline, 37)
                  Text.Nextline = strip(substr(Text.Textline, Wordbreak)' 'Text.Nextline)
                  Text.Textline = strip(left(Text.Textline, Wordbreak))
                end
                ID = PrintText(1, 1, CurrentFont, 'N', TextColor, Width.CurrentFont, Text.Textline)
                if App == 'FW' then redraw
                TextWidth.Textline = GetWidth(ID)
                if App == 'FW' then DELETEOBJECT ID
                else if App == 'PGS' then do
                  SELECTOBJECT OBJECTID ID WINDOW winName
                  DELETEOBJECT OBJECTID ID WINDOW winName
                end

                NeededCompression.Textline = min(1, AllowedWidth/TextWidth.Textline)
                if (NeededCompression.Textline < MinWidth/100) & (Words(Text.Textline) > 1) then do
                  /* Move last word to next line */
                  Wordbreak     = lastpos(' ', Text.Textline)
                  Text.Nextline = strip(substr(Text.Textline, Wordbreak)' 'Text.Nextline)
                  Text.Textline = strip(left(Text.Textline, Wordbreak))
                end
                else if Text.Nextline ~= '' then Textline = Textline + 1
              end
              LineCount = Textline
            end

            MaxCompression = 1
            do i = 0 to LineCount
              MaxCompression = min(MaxCompression, NeededCompression.i)
            end
            TextWidth = MaxCompression * Width.CurrentFont
            if App == 'FW' then TextWidth = min(max(trunc(TextWidth), 4), 255)

            if Box then do
              UndoItem = UndoItem + 1
              Undo.UndoLevel.UndoItem = DrawBox(LeftEdge, BoxTop + Line * Height.Highlight, AllowedBoxWidth, Height.CurrentFont * (LineCount + 1), 'HL', Line.AddEvent, 1, BoxColor, 100)
            end
            if event ~= '' then do
              do i = 0 to LineCount
                Text.Top = BoxTop + (Line + i) * Height.Highlight
                if Box == 0 then Text.Left = LeftEdge + Indent.i
                else Text.Left = LeftEdge + (AllowedBoxWidth - TextWidth.i * MaxCompression) / 2
                UndoItem = UndoItem + 1
                Undo.UndoLevel.UndoItem = PrintText(Text.Left, Text.Top, CurrentFont, 'N', TextColor, TextWidth, Text.i)
              end
            end
          end

          Day1 = NextDay1
          if Day1 > Day2 then leave
          else if (trunc((Day1 + StartDate - 1) / 7) > 4) & (Day2 > MonthLength.Month) then Day2 = Day1
        end

        if Weekly == 1 then do
          EnteredDay1 = EnteredDay1 + 7
          EnteredDay2 = EnteredDay2 + 7
        end
        else if Weekly == 2 then do
          EnteredDay1 = EnteredDay1 + 14
          EnteredDay2 = EnteredDay2 + 14
        end
      end
      else Weekly = 0
    end
    if App == 'FW' then redraw
    else if App == 'PGS' then SELECTOBJECT None WINDOW winName
  end

  Undo.UndoLevel.0 = UndoItem
  call CloseBusy(Req)

  if App == 'PGS' then do
    REFRESH ON ALL
    REFRESHWINDOW WINDOW winName
    WindowRefreshed = 1
  end

return
/**/

/***//*** QuoteIt (PROCEDURE) ***/
QuoteIt: PROCEDURE
  parse arg String

  String = strip(String)
  if (left(String, 1) == '"') & (right(String, 1) == '"') then return String
  else if (left(String, 1) == "'") & (right(String, 1) == "'") then return String
  else if pos("'", String) == 0 then return "'"String"'"
  else return '"'String'"'

  return
/**/

/***//*** ReadBrowserList (RBL) ***/
ReadBrowserList:
  parse arg RBL_FileHandle, RBL_GadIDList, RBL_ItemList, RBL_CurrentItem

  interpret 'RBL_AlreadyOpen = 'RBL_FileHandle
  if RBL_AlreadyOpen == 0 then do
    call ToPIPE(RBL_FileHandle, 'open')
    if (RBL_CurrentItem ~= '') & (MemberID(RBL_CurrentItem, RBL_ItemList) > 0) then call ToPIPE(RBL_FileHandle, 'id 1 s='MemberID(RBL_CurrentItem, RBL_ItemList) + 2)
    interpret RBL_FileHandle '= 1'
  end
  else do
    if (RBL_CurrentItem ~= '') & (MemberID(RBL_CurrentItem, RBL_ItemList) > 0) then call ToPIPE(RBL_FileHandle, 'id 1 s='MemberID(RBL_CurrentItem, RBL_ItemList) + 2)
    call ToPIPE(RBL_FileHandle, 'id 0 s=64')
  end

  do while ~eof(RBL_FileHandle)
    call ToPIPE(RBL_FileHandle, 'continue')
    RBL_Result = readln(RBL_FileHandle)
    parse var RBL_Result . . . . RBL_NodeID
    RBL_NodeID = strip(RBL_NodeID)
    interpret 'RBL_ListID = 'RBL_GadIDList'.RBL_NodeID'
    if pos('gadget', RBL_Result) > 0 then leave
  end
  call ToPIPE(RBL_FileHandle, 'id 0 s=128')
  interpret 'RBL_Entry = 'RBL_ItemList'.'RBL_ListID
  return RBL_Entry
/**/

/***//*** ReadFile (PROCEDURE) Subroutine ***/
ReadFile: PROCEDURE
  parse arg file

  if open('Temp', file) then do
    val = strip(readch('Temp', 65535), 'B', ' '||'0a'x)
    call close('Temp')
  end
  else val = ''
  return val
/**/

/***//*** ReadToEOL (PROCEDURE) Subroutine ***/
ReadToEOL: PROCEDURE
  parse arg Start, Var

  if Start == 0 then return ''

  EOL = pos('0a'x, Var, Start)
  if EOL == 0 then EOL = length(Var)

  return substr(Var, Start, EOL - Start)
/**/

/***//*** Round (PROCEDURE) ***/
Round: PROCEDURE
  parse arg num, places

  TruncNum = trunc(num, places)

  if (num - TruncNum) == 0 then return TruncNum

  TruncRem = '.'substr(num, pos('.', num) + places + 1)
  if TruncRem < .5 then return TruncNum
  else return ((TruncNum * 10**places) + 1)/(10**places)

  return
/**/

/***//*** SaveMsg (SM) Subroutine ***/
SaveMsg:
  parse arg SM_Msg
  if LogOpen ~= 1 then do
    LogTime = translate(time(), '.', ':')
    LogOpen = open('FWCLog', ScriptDir'FWCLog'LogTime'.txt', 'W')
    call writeln('FWCLog', '      Macro: 'strip(substr(sourceline(4), pos(':', sourceline(4)) + 1)))
    call writeln('FWCLog', 'Application: 'PgmVersion)
    call writeln('FWCLog', 'Current Dir: 'CurrentDir)
    call writeln('FWCLog', ' Script Dir: 'ScriptDir)
    call writeln('FWCLog', '       Host: 'CallHost)
    call writeln('FWCLog', '   Calendar: 'Month.Month' 'Year||'0a'x)
    call close('FWCLog')
  end

  LogOpen = open('FWCLog', ScriptDir'FWCLog'LogTime'.txt', 'A')
    call writeln('FWCLog', SM_Msg)
  call close('FWCLog')

  return
/**/

/***//*** Syntax () Subroutine ***/
Syntax:
  signal off syntax

  ErrorLine  = SIGL
  SourceLine = strip(SourceLine(ErrorLine))

  call AddMsg('E', 'Error 'RC' ('errortext(RC)')')
  call AddMsg('E', 'Line 'ErrorLine': 'SourceLine)
  call AddMsg('E', ParseVariables(SourceLine))

  call Cleanup
  exit
/**/

/***//*** ToPIPE (TP) ***/
ToPIPE:
  parse arg PipeName, TP_CMD

  call writeln(PipeName,' 'TP_CMD)
  TP_Response=readln(PipeName)

  parse var TP_Response TP_Response1 TP_Response2 .

  if TP_Response1 == 'ok' then return(TP_Response2)
  if TP_Response == '' then TP_Response = 'Blank line'
  call AddMsg('E', 'Line : 'SIGL)
  call AddMsg('E', PipeName' error: 'TP_Response)
  call AddMsg('E', 'Returned from: 'TP_CMD)
  call Cleanup
/**/

/***//*** TranslationStrings () ***/
TranslationStrings:
Sunday$    = 'Sunday'
Monday$    = 'Monday'
Tuesday$   = 'Tuesday'
Wednesday$ = 'Wednesday'
Thursday$  = 'Thursday'
Friday$    = 'Friday'
Saturday$  = 'Saturday'

January$   = 'January'
February$  = 'February'
March$     = 'March'
April$     = 'April'
May$       = 'May'
June$      = 'June'
July$      = 'July'
August$    = 'August'
September$ = 'September'
October$   = 'October'
November$  = 'November'
December$  = 'December'

AddEvent$       = 'Add Event'
AddIC$          = '+IC'
All$            = 'All'
BiOrWeekly$     = '(Bi)Weekly'
Biweekly$       = 'Biweekly'
Bottom$         = 'Bottom'
BoxColor$       = 'Box'
BoxDates$       = 'Box Dates'
Boxed$          = '_Boxed'
Calendar$       = 'Calendar'
Calendars$      = 'Calendars'
Cancel$         = '_Cancel'
CantFind$       = "can't be found"
Center$         = 'Center'
Clear$          = 'Clear'
Color$          = 'Color'
Colors$         = 'Colors'
Comment$        = 'Comment'
Critical$       = 'Critical error'
DailyColors$    = 'Use daily colors'
DeleteEvent$    = 'Delete Event'
Done$           = 'Done'
Easter$         = 'Easter'
End$            = 'End'
EnterEvent$     = 'You must enter an event...'
EnterEventInfo$ = 'Enter event information'
EnterNewIC$     = 'Enter new ImageClass'
EnterStartdate$ = 'You must enter a start date...'
Even$           = 'Even'
Event$          = 'Event'
Extended$       = 'Extended'
File$           = 'File'
First$          = 'First'
Fixed$          = 'Fixed'
Floating$       = 'Floating'
Font$           = 'Font'
Fonts$          = 'Fonts'
ForDetails$     = 'for details'
ForwardContent$ = 'Forward contents of output to'
ForwardLog$     = 'Forward log file to'
Fourth$         = 'Fourth'
Frequency$      = 'Frequency'
GeneratingM$    = 'Generating %s %s calendar'
GeneratingY$    = 'Generating %s calendar'
Go$             = 'Go'
Header$         = '%s %s'
HighlightEd$    = 'Highlight Editor'
Highlights$     = 'Highlights'
History$        = 'History'
Holiday$        = 'Holiday'
Image$          = 'Image'
Images$         = 'Images'
Julian$         = 'Julian'
JulJulLeft$     = 'Jul/Jul Left'
JulLeft$        = 'Jul Left'
Last$           = 'Last'
Left$           = 'Left'
Line$           = '_Line'
Load$           = '_Load'
MatchColors$    = 'Date Color = Highlight Color'
MiniCals$       = 'MiniCals'
MiscVar$        = 'Miscellaneous Variables'
MultiMonth$     = 'Multi-Month'
MustUse$        = 'You must use the gadget to'||'0a'x||'the right for this value.'
NextDay$        = 'Next day'
Noncritical$    = 'Noncritical warning'
None$           = 'None'
NotClear$       = '<'Clear$'> can only be used for "Background." variables...'
Note$           = 'Notes'
NoteBox$        = 'Note box'
Notice$         = 'notice'
Odd$            = 'Odd'
OK$             = '_OK'
OK2$            = 'OK'
Once$           = 'Once'
Options$        = 'Options'
OptLayout$      = 'Options & Layout'
OrientMarg$     = 'Orientation & Margins'
Phases$         = 'Phases'
PleaseWait$     = 'please wait'
PrepReq$        = 'Preparing requester'
PreviousDay$    = 'Prev day'
ProcessEvents$  = 'Processing events'
Random$         = 'Random'
Reset$          = '_Reset'
Right$          = 'Right'
RiseSet$        = 'Rise/Set'
SaveAs$         = '_Save as'
Second$         = 'Second'
See$            = 'see'
SeeOutput$      = 'see the output above for details'
SeeShell$       = 'see the shell output for details'
SelectApp$      = 'Select application'
SelectFile$     = 'Select data file'
SelectFont$     = 'Select font'
SelectImage$    = 'Select image'
SelectPrefs$    = 'Select name for prefs file'
SingleMonth$    = 'Single Month'
Start$          = 'Start'
SubHeader$      = ''
Sunrise$        = 'Sunrise'
Sunset$         = 'Sunset'
Tall$           = 'Tall'
TextColor$      = 'Text'
Third$          = 'Third'
Top$            = 'Top'
TopLong$        = 'Extra week at top'
Type$           = 'Type'
Unable$         = 'if you are unable to resolve the problem.'
Undo$           = 'Undo'
VarGUITitle$    = 'Set desired variables'
Variables$      = 'Variables'
View$           = 'View'
Weekend$        = 'Weekend'
Weekly$         = 'Weekly'
WeekNumber$     = 'Week Number'
WeekType$       = 'Week Type'
WholeYear$      = 'Whole Year'
Wide$           = 'Wide'

Help$                       = 'Help message'
Help$.ClickTabHelp          = 'Different tabs display*ndifferent variables'
Help$.MiniCalsGadHelp       = 'Include mini-calendars showing*nthe previous & next months'
Help$.HighlightsGadHelp     = 'Include highlights on*nthe generated calendar'
Help$.ImagesGadHelp         = 'Include images on*nthe generated calendar'
Help$.BoxDatesGadHelp       = 'Surround day numbers*nwith boxes'
Help$.ExtendedGadHelp       = 'Include days from the previous*nand next months on the*ngenerated calendar'
Help$.TopLongGadHelp        = 'Include days from the sixth week*nat the top of the calendar'
Help$.NoteBoxGadHelp        = 'Include an area to write notes*nwhere no dates are printed'
Help$.TopMargGadHelp        = "Set calendar's top margin*nRemember to <RETURN>"
Help$.LeftMargGadHelp       = "Set calendar's left margin*nRemember to <RETURN>"
Help$.OrientationGadHelp    = "Set calendar's orientation"
Help$.RightMargGadHelp      = "Set calendar's right margin*nRemember to <RETURN>"
Help$.BottomMargGadHelp     = "Set calendar's bottom margin*nRemember to <RETURN>"
Help$.FontVarGadHelp        = 'Select the font variable to set'
Help$.FontValGadHelp        = 'Displays the choosen font value'
Help$.ChooseFontGadHelp     = 'Select the desired font'
Help$.ColorVarGadHelp       = 'Select the color variable to set'
Help$.CycleColorVarGadHelp  = 'Cycle through the color variables*nShift to reverse cycle'
Help$.ColorValGadHelp       = 'Select the desired color'
Help$.MatchColorsGadHelp    = 'Use the highlight text color*nfor the date/date box'
Help$.DailyColorsGadHelp    = 'Use the Color.(Weekday) colors*nfor the date/date box'
Help$.HighlightEditGadHelp  = 'Bring up the*nHighlight Editor'
Help$.MiscVarGadHelp        = 'Select the desired*nmiscellaneous variable'
Help$.CycleMiscVarGadHelp   = 'Cycle through the miscellaneous variables*nShift to reverse cycle'
Help$.MiscValGadHelp        = 'Enter the desired variable value'
Help$.ChooseValGadHelp      = 'Used only for selecting files/paths'
Help$.AddImageClassGadHelp  = 'Add an ImageClass variable'
Help$.Extra3Help            = "Select extra to be printed*nin calendar's top-center"
Help$.Extra4Help            = "Select extra to be printed*nin calendar's top-right"
Help$.Extra0Help            = "Select extra to be printed*nin calendar's bottom-left"
Help$.Extra1Help            = "Select extra to be printed*nin calendar's bottom-center"
Help$.Extra2Help            = "Select extra to be printed*nin calendar's bottom-right"
Help$.CalendarTypeGadHelp   = 'Select calendar type'
Help$.EndMonthGadHelp       = 'Select desired end month'
Help$.StartMonthGadHelp     = 'Select desired start month'
Help$.MonthGadHelp          = 'Select desired month'
Help$.YearGadHelp           = 'Select or enter desired year'
Help$.GoGadHelp             = 'Begin generation of calendar'
Help$.ResetGadHelp          = 'Reset all variables to defaults'
Help$.LoadGadHelp           = 'Load a new preference file'
Help$.SaveAsGadHelp         = 'Save current settings to*na new preference file'
Help$.CancelGadHelp         = 'Cancel FWCalendar'
Help$.EH_EventGadHelp       = 'Enter the Highlight as it*nwill show up on calendar'
Help$.EH_ChooseEventGadHelp = 'Select Image file to be printed on calendar'
Help$.EH_ListEventGadHelp   = 'List all Highlights*nfor current month'
Help$.EH_CycleEventGadHelp  = 'Cycle through all Highlights*nfor current month'
Help$.EH_CommentGadHelp     = 'Enter optional comment'
Help$.EH_MonthGadHelp       = 'Select month to work with'
Help$.ExtraDHelp            = 'Select the date on*nwhich the Highlight falls'
Help$.LD                    = 'Indicates the Highlight always falls*non the last day of the month'
Help$.EH_ColorGadHelp       = 'Select color to be*nused for the Highlight'
Help$.EH_HLTypeGadHelp      = 'Select the Highlight type'
Help$.EH_WeekNumberGadHelp  = 'Select which week a floating*nHighlight occurs in'
Help$.EH_WeekTypeGadHelp    = 'Select frequency of weekly Highlights'
Help$.EH_WeekendGadHelp     = 'Determine whether or not the*nHighlight can fall on a weekend'
Help$.EH_HolidayGadHelp     = 'Treat the Highlight as a holiday'
Help$.EH_EasterGadHelp      = 'The number of days before or*nafter Easter for the Highlight'
Help$.EH_AddEventGadHelp    = 'Add a new Highlight'
Help$.EH_DeleteEventGadHelp = 'Delete the currently*ndisplayed Highlight'
Help$.EH_DoneGadHelp        = 'Save all changes to Highlights'
Help$.GE_EventTypeGadHelp   = 'Select to enter Event or*nuse an Event file'
Help$.GE_EventGadHelp       = 'Enter Event or display Event file'
Help$.GE_FontNameGadHelp    = 'Display font to be used'
Help$.GE_FontSizeGadHelp    = 'Enter font size to use'
Help$.GE_ChooseFontGadHelp  = 'Select font to be used'
Help$.GE_ResetGadHelp       = 'Reset font and font size'
Help$.GadIDHelp             = 'Enter Event start and end dates'
Help$.GE_StartGadHelp       = 'Display Event start date'
Help$.GE_EndGadHelp         = 'Display Event end date'
Help$.GE_TextColorGadHelp   = 'Select color to be*nused for Event text'
Help$.GE_LineGadHelp        = 'Select row on which*nEvent will be printed'
Help$.GE_BoxedGadHelp       = 'Surround Event with a box'
Help$.GE_BoxColorGadHelp    = 'Select color for box*nsurrounding Event'
Help$.GE_FrequencyGadHelp   = 'Select frequency of Event'
Help$.GE_OKGadHelp          = 'Use entered data to add*nEvent to calendar'
Help$.GE_CancelGadHelp      = 'Cancel FWCAddEvent'

return 0
/**/

/***//*** VIO Routines () Subroutine ***/
/***//** OpenV() **/
OpenV:
  parse arg VIO_Variable

  if Open.VIO_Variable ~= 1 then do
    Open.VIO_Variable = 1
    Pointer.VIO_Variable = 1
    EOF.VIO_Variable = 0
    return 1
  end
  else return 0
/**/

/***//** CloseV() **/
CloseV:
  parse arg VIO_Variable

  If Open.VIO_Variable == 0 then return 0
  Open.VIO_Variable = 0
  return 1
/**/

/***//** SeekV() **/
SeekV:
  parse arg VIO_Variable, VIO_Offset, VIO_Anchor

  if Open.VIO_Variable == 1 then do
    VIO_Anchor = upper(left(VIO_Anchor, 1))

    VIO_Value = Value(VIO_Variable)
    select
      when VIO_Anchor == 'B' then Pointer.VIO_Variable = VIO_Offset
      when VIO_Anchor == 'E' then Pointer.VIO_Variable = length(VIO_Value) + VIO_Offset
      otherwise Pointer.VIO_Variable = Pointer.VIO_Variable + VIO_Offset
    end

    if Pointer.VIO_Variable > length(VIO_Value) then Pointer.VIO_Variable = length(VIO_Value) + 1
    return Pointer.VIO_Variable
  end
  else return 0
/**/

/***//** ReadVCh() **/
ReadVCh:
  parse arg VIO_Variable, VIO_Length

  if VIO_Length == '' then VIO_Length = 1

  if Open.VIO_Variable == 1 then do
    if EOF.VIO_Variable == 0 then do
      VIO_Value = Value(VIO_Variable)
      VIO_Ret = substr(VIO_Value, Pointer.VIO_Variable, VIO_Length)
      Pointer.VIO_Variable = Pointer.VIO_Variable + VIO_Length
      if Pointer.VIO_Variable > length(VIO_Value) then EOF.VIO_Variable = 1
      else EOF.VIO_Variable = 0
    end
    else VIO_Ret = ''
  end
  else VIO_Ret = ''

  return VIO_Ret
/**/

/***//** ReadVLn(RV) **/
ReadVLn:
  parse arg VIO_Variable, VIO_Count, VIO_SepChar

  if VIO_Count == '' then VIO_Count = 1
  if VIO_SepChar == '' then VIO_SepChar = '0a'x

  if Open.VIO_Variable == 1 then do
    VIO_Value = Value(VIO_Variable)
    VIO_Ret   = ''
    do VIO_i = 1 to VIO_Count
      VIO_LF = pos('0a'x, VIO_Value, Pointer.VIO_Variable)
      if VIO_LF > 0 then do
        VIO_Ret = VIO_Ret''substr(VIO_Value, Pointer.VIO_Variable, VIO_LF - Pointer.VIO_Variable)
        Pointer.VIO_Variable = VIO_LF + 1
        if VIO_LF = length(VIO_Value) then EOF.VIO_Variable = 1
        else EOF.VIO_Variable = 0
      end
      else do
        if Pointer.VIO_Variable < length(VIO_Value) then do
          VIO_Ret = VIO_Ret''substr(VIO_Value, Pointer.VIO_Variable)
          Pointer.VIO_Variable = length(VIO_Value) + 1
          EOF.VIO_Variable = 1
        end
      end
      if EOF.VIO_Variable == 1 then leave
      if VIO_i ~= VIO_Count then VIO_Ret = VIO_Ret''VIO_SepChar
    end
  end
  else VIO_Ret = ''

  return VIO_Ret
/**/

/***//** WriteVCh() **/
WriteVCh:
  parse arg VIO_Variable, VIO_String, VIO_Option

  VIO_Value  = Value(VIO_Variable)
  VIO_Option = upper(left(VIO_Option, 1))
  VIO_Length = length(VIO_Value)
  if VIO_Option == 'C' then do
    VIO_Value = Insert(VIO_String, VIO_Value, Pointer.VIO_Variable - 1)
    Pointer.VIO_Variable = Pointer.VIO_Variable + length(VIO_String)
  end
  else if VIO_Option == 'B' then do
    VIO_Value = VIO_String''VIO_Value
    Pointer.VIO_Variable = length(VIO_String) + 1
  end
  else do
    VIO_Value = VIO_Value''VIO_String
    Pointer.VIO_Variable = length(VIO_Value)
  end
  interpret VIO_Variable'= VIO_Value'
  if length(VIO_Value) = VIO_Length + length(VIO_String) then VIO_Ret = length(VIO_String)
  else VIO_Ret = 0

  return VIO_Ret
/**/

/***//** WriteVLn() **/
WriteVLn:
  parse arg VIO_Variable, VIO_String, VIO_Option

  return WriteVCh(VIO_Variable, VIO_String||'0a'x, VIO_Option)
/**/

/***//** EOFV() **/
EOFV:
  parse arg VIO_Variable

  if Open.VIO_Variable == 1 then return EOF.VIO_Variable
  else return 1
/**/
/**/

/***//*** WriteFile (PROCEDURE) Subroutine ***/
WriteFile: PROCEDURE
  parse arg file, var, which

  if open('Temp', file, 'W') then do
    success = writech('Temp', var)
    call close('Temp')
  end
  if (upper(which) == 'B') & (upper(left(file, 4)) == 'ENV:') then call WriteFile('ENVARC:'substr(file, 5), var)

  return success
/**/

/***//*** SetVariables Subroutine ***/
SetVariables:
/***//**** Initialize Variables ****/
  Date            = 0
  esc             = "1B"x
  QuoteMark       = d2c(34)
  EventFile       = ''
  FontKnown.      = ''
  FSize.          = 10
  HighestFont     = 5
  Highlight       = 5
  ImageType.      = ''
  PatVar          = '#?.data'
  PrefsFile       = ''
  Req             = 0
  Storage         = 'RAM:FWC/'
  Width.          = 100
  UndoLevel       = 0
  ColorW          = 80
  ColorH          = 10
  PE_ImageCount   = 0

  if App == 'FW' then DefaultFont = "SoftSans"
  else if App == 'PGS' then DefaultFont = 'PageStream-Normal'

  PGSRecognizedFormats = '|PICT|TIFF|IFFILBM|GIF|BMP|IFFDR2D|IFFILUS|JPEG|MACPAINT|PRODRAW|PCX|ILLUSTRATOREPS|FREEHANDEPS|ARTEXPRESSIONEPS|EPS|'

  PGSFilter.     = ''
  PGSFilter.ILBM = 'IFFILBM'
  PGSFilter.JFIF = 'JPEG'
  PGSFilter.POST = 'IllustratorEPS'

  GfxCmd.FWCalendar       = ''
  GfxTemplate.FWCalendar  = 'ImgDT ImgWidth ImgHeight .'

  GfxCmd.Visage           = '%s info'
  GfxTemplate.Visage      = '. "0a"x . ImgDT ImgWidth "x" ImgHeight "x" .'

  GfxCmd.ImageDTInfo      = '%s'
  GfxTemplate.ImageDTInfo = 'ImgDT "-" ImgWidth "x" ImgHeight "x" .'

  GfxCmd.PicSize          = '%s "%t %w %h"'
  GfxTemplate.PicSize     = 'ImgDT ImgWidth ImgHeight "0a"x'

  D.0 = 'Sunday'
  D.1 = 'Monday'
  D.2 = 'Tuesday'
  D.3 = 'Wednesday'
  D.4 = 'Thursday'
  D.5 = 'Friday'
  D.6 = 'Saturday'

  EnglishSunday$    = 'Sunday'
  EnglishMonday$    = 'Monday'
  EnglishTuesday$   = 'Tuesday'
  EnglishWednesday$ = 'Wednesday'
  EnglishThursday$  = 'Thursday'
  EnglishFriday$    = 'Friday'
  EnglishSaturday$  = 'Saturday'

  MonthLength.1    = 31
  MonthLength.2    = 28
  MonthLength.3    = 31
  MonthLength.4    = 30
  MonthLength.5    = 31
  MonthLength.6    = 30
  MonthLength.7    = 31
  MonthLength.8    = 31
  MonthLength.9    = 30
  MonthLength.10   = 31
  MonthLength.11   = 30
  MonthLength.12   = 31

  Month.1  = January$
  Month.2  = February$
  Month.3  = March$
  Month.4  = April$
  Month.5  = May$
  Month.6  = June$
  Month.7  = July$
  Month.8  = August$
  Month.9  = September$
  Month.10 = October$
  Month.11 = November$
  Month.12 = December$
/**/

/***//**** Read default variables ****/
  call open('Temp', FullCallPath)
    call seek('Temp', -5000, 'E')
    Chunk = readch('Temp', 65535)
    EndPos = pos('VarList:'||'0a'x, Chunk)
    if EndPos == 0 then do
      call AddMsg('E', 'Unable to locate default variables.')
      call CleanUp
    end
    RD_VariableFile = substr(Chunk, EndPos + 9)
  call close('Temp')
  interpret left(RD_VariableFile, pos('return', RD_VariableFile) - 1)
/**/

/***//**** Determine prefs file from calendar ****/
  if App == 'FW' then do
    FIRSTOBJECT; TempDateID = result
    do forever
      if TempDateID == 0 then do
        call AddMsg('E', 'Unable to find FWC date string.')
        call AddMsg('E', 'Make sure a Monthly calendar created by FWCalendar.rexx is currently loaded.')
        call Cleanup
      end
      GETOBJECTTYPE TempDateID; ObjectType = result
      if ObjectType == 7 then do
        GETTEXTBLOCKTEXT TempDateID; TempDate = result
        if (left(TempDate, 3) == 'FWC') & (datatype(substr(TempDate, 4, 8)) == 'NUM') then leave
      end
      NEXTOBJECT TempDateID; TempDateID = result
    end
    do while right(TempDate, 1) == '|'
      StartObj = pos('|', TempDate)
      NextObj = strip(substr(TempDate, StartObj), 'B', '|')
      if NextObj == TempDateID then NextObj = NextObj - 1
      GETTEXTBLOCKTEXT NextObj; NextPart = result
      TempDate = left(TempDate, StartObj - 1)''NextPart
    end
  end
  else if App = 'PGS' then do
    CURRENTWINDOW; winName = '"'RESULT'"'
    SELECTTEXT at 0 0 WINDOW winName
    SELECTTEXT ALL WINDOW winName
    EXPORTTEXT AMIGA FILE "PIPE:FWC" FILTER "ASCII" STATUS FORCE
    TempDate = ReadFile("PIPE:FWC")
    SENDTOBACK WINDOW winName
    if (left(TempDate, 3) ~= 'FWC') | (datatype(substr(TempDate, 4, 8)) ~= 'NUM') then do
      call AddMsg('E', 'Unable to find FWC date string.')
      call AddMsg('E', 'Make sure a Monthly calendar created by FWCalendar.rexx is currently loaded.')
      call Cleanup
    end
    else do
      do while right(TempDate, 1) == '|'
        StartPointer = pos('|', TempDate)
        SELECTTEXT at 0 0 WINDOW winName
        SELECTTEXT ALL WINDOW winName
        EXPORTTEXT AMIGA FILE "PIPE:FWC" FILTER "ASCII" STATUS FORCE
        TempDate = left(TempDate, StartPointer - 1)''readfile("PIPE:FWC")
        SENDTOBACK WINDOW winName
      end
    end
  end
  if pos('~', TempDate) == 12 then do
    FWCVer = substr(TempDate, pos('~', TempDate) + 1)
    StartPrefs = pos('~', FWCVer)
    PrefsFile = substr(FWCVer, StartPrefs + 1)
    FWCVer = left(FWCVer, StartPrefs - 1)
    TempDate = substr(TempDate, 4, 8)
  end
  else FWCVer = 0

  if FWCVer < MinFWCVer then do
    call AddMsg('E', 'This version of FWCAddEvent will only work with calendars')
    call AddMsg('E', 'created with FWCalendar version 'MinFWCVer' or later.')
    if FWCVer > 0 then call AddMsg('E', 'This calendar was created with FWCalendar v'FWCVer'.')
    else call AddMsg('E', 'This calendar was created with FWCalendar pre-v4.22.')
    call Cleanup
  end
/**/

/***//**** Get application colors ****/
  if App == 'FW' then do
    FWPrefs = ReadFile(CurrentDir'FWFiles/FW.Prefs')
    ColorTable = pos('SWCL', FWPrefs) + 12
    EndTable = pos('STUP', FWPrefs)
    ColorCount = 0
    Do CTPos = ColorTable to EndTable by 20
      ColorRegister.ColorCount = c2x(substr(FWPrefs, CTPos - 3, 3))
      ColorList.ColorCount = strip(substr(FWPrefs, CTPos, 16), 'B', '00'x)
      if ColorRegister.ColorCount = '000000' then Black$ = ColorList.ColorCount
      if ColorRegister.ColorCount = 'FFFFFF' then White$ = ColorList.ColorCount
      ColorCount = ColorCount + 1
    end
    ColorList.ColorCount = '<'Clear$'>'
    ColorCount = ColorCount + 1
    ColorList.COUNT = ColorCount
    if symbol('Black$') == 'LIT' then do
      call AddMsg('W', "The color black can't be found; "ColorList.0" used instead.")
      Black$ = ColorList.0
    end
    if symbol('White$') == 'LIT' then do
      call AddMsg('W', "The color white can't be found; "ColorList.1" used instead.")
      White$ = ColorList.1
    end
  end
  else if App == 'PGS' then do
    GETFONTLIST FontList
    FontList.COUNT = result

    PGSColors = ReadFile(CurrentDir''word(PgmVersion, 1)'.colors')
    ColorCount = 0
    StartTag = pos('TG'||'00'x, PGSColors)
    do while StartTag ~= 0
      Color = substr(PGSColors, StartTag + 10, c2d(substr(PGSColors, StartTag + 9, 1)))
      AccentMarker = pos(d2c(129), Color)
      do while AccentMarker > 0
        Color = overlay(d2c(c2d(substr(Color, AccentMarker + 1, 1)) + 128), delstr(Color, AccentMarker, 1), AccentMarker)
        AccentMarker = pos(d2c(129), Color)
      end
      ColorList.ColorCount = Color
      ColorCount = ColorCount + 1
      StartTag = pos('TG'||'00'x, PGSColors, StartTag + 10)
    end
    ColorList.ColorCount = '<'Clear$'>'
    ColorCount = ColorCount + 1
    ColorList.COUNT = ColorCount
    White$ = ColorList.0
    Black$ = ColorList.1
  end
  TextColorList.Count = ColorList.COUNT - 1

  do i = 0 to TextColorList.Count - 1
    TextColorList.i = ColorList.i
  end

  Color.          = Black$
  Line.           = Black$
  Background.     = White$
/**/

  GSI_Data = ReadFile(PrefsFile)
  if GSI_Data ~= '' then do
    GSI_UpperData = upper(GSI_Data)
    interpret ReadToEOL(pos('STORAGE', GSI_UpperData), GSI_UpperData)
    interpret ReadToEOL(pos('FORCEBGUI', GSI_UpperData), GSI_UpperData)
    interpret ReadToEOL(pos('HOSTSCREEN', GSI_UpperData), GSI_UpperData)

    if ForceBGUI == 1 then call AddBGUI
    if HostScreen ~= '' then AppScreen = HostScreen
  end
  address command 'makedir >NIL: 'left(Storage, length(Storage) - 1)

  if (PrefsFile ~= 'Default') & (exists(PrefsFile)) then do
    UserFile = ReadFile(PrefsFile)
    if UserFile ~= '' then do
      call openv('UserFile')
        do until eofv('UserFile')
          CD_VarLine = strip(ReadvLn('UserFile'))
          if left(CD_VarLine, 15) == '/* End Pass One' then leave
          if upper(left(CD_VarLine, 11)) == 'IMAGECLASS.' then iterate
          interpret CD_VarLine
        end
      call closev('UserFile')
    end
  end
  drop Orientation

  Type.0    = Event$
  Type.1    = Image$
  Type.2    = File$
  FSize.4pt = 4

  CalendarBorder = CalendarBorder / 100
  CalendarShadow = CalendarShadow / 100
  CornerRadius   = CornerRadius / 100
  DateOffset     = DateOffset / 100
  MaxImgHeight   = MaxImgHeight / 100
  MaxImgWidth    = MaxImgWidth / 100
  StretchDateH   = StretchDateH / 100
  StretchDateW   = StretchDateW / 100
  TextAdj        = TextAdj / 100
  TTextArea      = TTextArea / 100
  WTextArea      = WTextArea / 100

  do i = 0 to 6
    val = i - StartWeek
    if val < 0 then val = 7 + val
    interpret 'Day.'D.i '=' val
    interpret 'Day.val = English'D.i'$'
    interpret 'TransDay.val = 'D.i'$'
  end

  if Symbol('EndWeek') == 'LIT' then EndWeek = -1
  if EndWeek < 0 then EndWeek = StartWeek - 1
  if EndWeek < 0 then EndWeek = 6
  if EndWeek < StartWeek then WeekdayCount = EndWeek + 7 - StartWeek
  else WeekdayCount = EndWeek - StartWeek

  if App == 'FW' then do
    TextBase = TextAdj
    do i = 0 to 5 by 5
      if Font.i == NameOnly(Font.i) then Font.i = CurrentDir'FWFonts/SWOLFonts/'Font.i
      if ~exists(Font.i) then do
        call AddMsg('W', NameOnly(Font.i)" can't be found; "DefaultFont" used instead.")
        Font.i = DefaultFont
      end
    end
    GETPAGESETUP ORIENT; FWC_Orientation = result
    if FWC_Orientation == 'Wide' then TextArea = WTextArea
    else TextArea = TTextArea

    GETDISPLAYPREFS Measure; UserPrefs = 'DISPLAYPREFS Measure 'result
    DISPLAYPREFS Measure Inches
    GETSECTIONSETUP Top Bottom Inside Outside
    parse var result Margin.Top Margin.Bottom Margin.Left Margin.Right

    GETPAGESETUP Width Height
    parse var result FullWidth FullHeight

    TextBlockPrefs TEXTFLOW None
  end
  else if App = 'PGS' then do
    TextBase = 1
    GETFONTLIST FontNames
    FontNames.COUNT = result
    do i = 0 to 5 by 5
      do j = 0 to FontNames.COUNT - 1
        if upper(Font.i) == upper(FontNames.j) then leave
      end
      if j == FontNames.COUNT then do
        call AddMsg('W', Font.i" can't be found; "DefaultFont" used instead.")
        Font.i = DefaultFont
      end
    end
    GETMASTERPAGES MPage; PageName = MPage.0
    GETMEASUREMENTS COORDINATE stemc RELATIVE rel TEXT tex FROM fro
    UserPrefs = 'SETMEASUREMENTS COORDINATE 'stemc.horizontal stemc.vertical' RELATIVE 'rel' TEXT 'tex' FROM 'fro
    SETMEASUREMENTS COORDINATE Inches Sameas RELATIVE Sameas TEXT Points FROM Page
    GETMARGINGUIDES temp
    Margin.Left   = temp.inside
    Margin.Right  = temp.outside
    Margin.Top    = temp.top
    Margin.Bottom = temp.bottom

    GETDIMENSIONS layout MASTERPAGE "'"PageName"'"
    if layout.orientation == 'LANDSCAPE' then do
      TextArea   = WTextArea
      FullWidth  = layout.height
      FullHeight = layout.width
    end
    else do
      TextArea   = TTextArea
      FullWidth  = layout.width
      FullHeight = layout.height
    end
  end
  PrintWidth       = FullWidth - Margin.Left - Margin.Right
  PrintHeight      = FullHeight - Margin.Top - Margin.Bottom

  if App == 'FW' then do
    GETOBJECTCOORDS TempDateID; Parse Var result . . . . Height.4pt
  end
  else if App == 'PGS' then Height.4pt = GetHeight(4pt)
  if ((PrintHeight - Height.4pt - (TextArea * PrintHeight))/5 * 8) >= 4 then
      PrintHeight = PrintHeight - Height.4pt

  CalendarBorder   = CalendarBorder * PrintWidth
  CalendarShadow   = CalendarShadow * PrintWidth
  PrintWidth       = PrintWidth - 2 * CalendarBorder - CalendarShadow
  PrintHeight      = PrintHeight - 2 * CalendarBorder - CalendarShadow
  Margin.Left      = Margin.Left + CalendarBorder

  BoxWidth         = PrintWidth/(WeekdayCount + 1)
  CalRight         = Margin.Left + BoxWidth * (WeekdayCount + 1)
  TextArea         = TextArea * PrintHeight
  CalTop           = TextArea + Margin.Top + CalendarBorder
  BoxHeight        = (PrintHeight - TextArea)/5
  CRadius          = CornerRadius * min(BoxHeight, BoxWidth)
  CurveOffset      = DateOffset * BoxWidth + CRadius * .25
  DateOffset       = DateOffset * BoxWidth
  FSize.Date       = BoxHeight/HighlightRows * 72 * StretchDateH
  Width.Date       = Width.Date * StretchDateW / StretchDateH
  FSize.Highlight  = BoxHeight/AddEventRows * 72
  if App == 'FW' then FSize.Highlight = max(trunc(FSize.Highlight), 4)
  if App == 'FW' then FSize.Date = max(trunc(FSize.Date), 4)
  Height.Highlight = GetHeight(Highlight) * Leading/100
  Height.Date      = GetHeight(Date) * Leading/100

  FontInfo = compress(Font.Highlight''FSize.Highlight, '. /:')
  FontKnown.FontInfo = Highlight

  RowsThatFit      = trunc(BoxHeight / Height.Highlight + 0.05)
  Width.WidthOfDate1 = GetFontWidth(Date, '1')
  Width.WidthOfDate8 = GetFontWidth(Date, '8')
  VariablesSet = 1

  interpret 'GfxCmd = GfxCmd.'GfxApp
  interpret 'GfxTemplate = GfxTemplate.'GfxApp
return
/**/

/***//*** VarList () Subroutine ***/
VarList:
  AddEventRows             = 9
  AdjustDST                = 1
  AltColor.Date            = Black$
  AltColor.Extended        = Black$
  AltColor.Highlight       = Black$
  AltColor.HighlightH      = Black$
  AltColor.History         = Black$
  AltColor.Julian          = Black$
  AltColor.Random          = Black$
  AltColor.Sunrise         = Black$
  AltColor.Sunset          = Black$
  AltColor.WeekNumber      = Black$
  Background.AddEvent      = White$
  Background.CalShadow     = Black$
  Background.Highlight     = '<'Clear$'>'
  Background.HighlightH    = '<'Clear$'>'
  Background.MiniCal       = White$
  Background.MiniCalShadow = Black$
  Background.NoteBox       = '<'Clear$'>'
  Background.Standard      = '<'Clear$'>'
  Background.Weekend       = '<'Clear$'>'
  BelzierFactor            = .55
  Bold.MiniCal             = DefaultBold
  Bold.FYMiniCal           = DefaultBold
  CalendarBorder           = 0
  CalendarShadow           = 0
  CenterHistory            = 1
  CenterMiniDates          = 1
  CenterRandom             = 1
  Color.Sunday             = Black$
  Color.Monday             = Black$
  Color.Tuesday            = Black$
  Color.Wednesday          = Black$
  Color.Thursday           = Black$
  Color.Friday             = Black$
  Color.Saturday           = Black$
  Color.AddEvent           = Black$
  Color.Date               = Black$
  Color.Extended           = Black$
  Color.Header             = Black$
  Color.Highlight          = Black$
  Color.HighlightH         = Black$
  Color.History            = Black$
  Color.Julian             = Black$
  Color.MiniCal            = Black$
  Color.Moon               = Black$
  Color.NoteBox            = Black$
  Color.Random             = Black$
  Color.SubHeader          = Black$
  Color.Sunrise            = Black$
  Color.Sunset             = Black$
  Color.Weekday            = Black$
  Color.WeekNumber         = Black$
  CornerRadius             = 0
  DateOffset               = 2
  DoDailyColors            = 0
  DoDateBox                = 0
  DoExtended               = 1
  DoHide                   = 0
  DoHighlights             = 0
  DoHistory                = ''
  DoImages                 = 0
  DoJulian                 = ''
  DoJulianLeft             = ''
  DoMatchColors            = 0
  DoMiniCals               = 1
  DoNoteBox                = 0
  DoPhases                 = ''
  DoRandom                 = ''
  DoSunRise                = ''
  DoSunSet                 = ''
  DoTopExtraWk             = 0
  DoWeekNumber             = ''
  FinalView                = 75
  Font.Date                = DefaultFont
  Font.Extras              = DefaultFont
  Font.Header              = DefaultFont
  Font.Highlight           = DefaultFont
  Font.MiniCal             = DefaultFont
  Font.FYMiniCal           = DefaultFont
  Font.Weekday             = DefaultFont
  Font.SubHeader           = DefaultFont
  ForceBGUI                = 0
  GenMVars                 = 'Month.Month EnteredYear'
  GenYVars                 = 'EnteredYear'
  GfxApp                   = 'FWCalendar'
  GfxAppPath               = ''
  HeaderLoc                = 9
  HeaderSize               = 50
  Header$                  = '%s %s'
  HeaderVars               = 'Month.Month Year'
  HelpTime                 = 4
  HighlightRows            = 9
  HostScreen               = ''
  LaunchM                  = ''
  LaunchY                  = ''
  Leading                  = 100
  Line.AddEvent            = Black$
  Line.CalBorder           = Black$
  Line.Extended            = Black$
  Line.Grid                = Black$
  Line.MiniCal             = Black$
  Line.NoteBox             = Black$
  MagnifyExtras            = 100
  Margin.Bottom            = 0
  Margin.Left              = 0
  Margin.Right             = 0
  Margin.Top               = 0
  MinHistoryWidth          = 70
  MinRandomWidth           = 70
  MinWidth                 = 80
  MaxImgHeight             = 75
  MaxImgWidth              = 75
  MiniCalHeight            = 60
  MiniCalSpacing           = 0.5
  MiniCalWidth             = 200
  MoonRadius               = 10
  Orientation              = 'Wide'
  PrefsName                = 'Default'
  ShadowType               = 'P'
  ShiftLMini               = 0
  ShiftRMini               = 0
  StartWeek                = 0
  StretchDateH             = 100
  StretchDateW             = 100
  SubHeaderLoc             = 0
  SubHeaderSize            = 0
  SubHeader$               = ''
  SubHeaderVars            = ''
  SunCalcPath              = ''
  Text.Julian              = ''
  Text.Sunrise             = ''
  Text.Sunset              = ''
  Text.WeekNumber          = ''
  TextAdj                  = 77
  TTextArea                = 15
  WeekdaySize              = 50
  WTextArea                = 20
return
/**/